Additional Coding: Update #6
davegoblue
November 6, 2016
Overview
This document explores video poker hands, using http://wizardofodds.com/games/video-poker/methodology/ as a template, and applying DataCamp_Insights_v001 materials where applicable. This document builds on the more salient components of the analysis in AdditionalCoding_v005.Rmd. In particular, the preparatory components are cached and saved, with a functional approach taken for assessing pay tables.
Analysis Approach
The Wizard of Odds suggests an 11-step approach to calculating the returns for a video poker pay table:
- Initialize arrays for discarding 0-5 cards
- Loop through all 52c5 hands, score them based on their poker value, then place them in the appropriate arrays (each of discard 0 through discard 5)
- Create the 134,459 non-duplicate starting hands possible (e.g., Ad Kh Tc 9c 3d is the same as As Kh Td 9d 3s), and assign it a weighting based on how much duplication it covers
- Lookup each of the 134,459 hands and score the discard 0 (hold 5) option
- Lookup every possible discard 1 (hold 4) option, find the EV in the discard 1 array and then subtract the outcome in the discard 0 array (cannot get back the same hand)
- Lookup every possible discard 2 (hold 3) option, find the EV in the discard 2 array and then subtract the outcomes in the discard 1 array and then add back the outcome in the discard 0 array (double-subtracted)
- Lookup every possible discard 3 (hold 2) option, find the EV in the discard 3 array and then subtract the outcomes in the discard 2 array and then add back the outcomes in the discard 1 array and then subtract out the outcome in the discard 0 array (typical set theory add/subtract)
- Lookup every possible discard 4 (hold 1) option, find the EV in the discard 4 array and then subtract the outcomes in the discard 3 array and then add back the outcomes in the discard 2 array and then subtract out the outcome in the discard 1 array and then add back the outcome in the discard 0 array (typical set theory add/subtract)
- Lookup every possible discard 5 (hold 0) option, find the EV in the discard 5 array and then subtract the outcomes in the discard 4 array and then add back the outcomes in the discard 3 array and then subtract out the outcome in the discard 2 array and then add back the outcome in the discard 1 array and then subtract out the outcome of the discard 0 array (typical set theory add/subtract)
- Calculate the EV of every possible decision, and assign the appropriate weightings
- Determine overall return, or other statistics of interest about the game
This program adapts the approach as follows:
- Preparatory work (cached) - create full matrices of hand types, and de-duplicated (weighted) matrix of unique starting hands
- Scoring - apply pay table to cached preparatory work
- Analysis - simulate pay table
Preparatory Work
Key libraries are sourced and global parameters set. In addition, all possible combinatorics are stored in an array, with functions declared to convert any given cards to an index. This component is not cached:
library(tidyr)
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(ggplot2)## Warning: package 'ggplot2' was built under R version 3.2.5library(microbenchmark)## Warning: package 'microbenchmark' was built under R version 3.2.5startTime <- proc.time()
totStart <- startTime
# Declare overall game variables
nHandTypes <- 50 # Number of hand types supported
nScores <- 16 # Number of final scores supported - many hand types may map to the same score
proc.time() - startTime## user system elapsed
## 0 0 0# Create a matrix to hold results for choose(n, k)
mtxCombin <- matrix(data=0L, nrow=52, ncol=5)
for (intCtr in 1:52) {
for (intCtr2 in 1:5) {
# Note that choose() is a guarded function where choose(n, k) returns 0 for k > n
mtxCombin[intCtr, intCtr2] <- as.integer(choose(intCtr, intCtr2))
}
}
idxCard1 <- function(c1) {
# Just return yourself
c1
}
idxCard2 <- function(c1, c2) {
# Need to convert the C++ algorithm which is 0:51 to R which wants 1:52
as.integer( 1 + mtxCombin[52, 2] - mtxCombin[53-c1, 2] +
mtxCombin[52-c1, 1] - mtxCombin[53-c2, 1]
)
}
idxCard3 <- function(c1, c2, c3) {
# Need to convert the C++ algorithm which is 0:51 to R which wants 1:52
as.integer(
1 + mtxCombin[52, 3] - mtxCombin[53-c1, 3] +
mtxCombin[52-c1, 2] - mtxCombin[53-c2, 2] +
mtxCombin[52-c2, 1] - mtxCombin[53-c3, 1]
)
}
idxCard4 <- function(c1, c2, c3, c4) {
# Need to convert the C++ algorithm which is 0:51 to R which wants 1:52
as.integer(
1 + mtxCombin[52, 4] - mtxCombin[53-c1, 4] +
mtxCombin[52-c1, 3] - mtxCombin[53-c2, 3] +
mtxCombin[52-c2, 2] - mtxCombin[53-c3, 2] +
mtxCombin[52-c3, 1] - mtxCombin[53-c4, 1]
)
}
idxCard5 <- function(c1, c2, c3, c4, c5) {
# Need to convert the C++ algorithm which is 0:51 to R which wants 1:52
as.integer(
1 + mtxCombin[52, 5] - mtxCombin[53-c1, 5] +
mtxCombin[52-c1, 4] - mtxCombin[53-c2, 4] +
mtxCombin[52-c2, 3] - mtxCombin[53-c3, 3] +
mtxCombin[52-c3, 2] - mtxCombin[53-c4, 2] +
mtxCombin[52-c4, 1] - mtxCombin[53-c5, 1]
)
}
proc.time() - startTime## user system elapsed
## 0.01 0.00 0.01Each of the 52c5 possible starting hands are created, with hand types declared. Of particular interest will be tracking the following, with results cached for time considerations:
- Nothing (0)
- Royal Flush (1)
- Straight Flush (2)
- Full House (3)
- Flush (4)
- Straight (5)
- Trips (6)
- Two Pair (7)
- Pair AA (8)
- Pair KK (9)
- Pair QQ (10)
- Pair JJ (11)
- Pair TT (12)
- Pair 22-99 (13)
- AAAA with 2-4 (14)
- AAAA with J-K (15)
- AAAA with 5-T (16)
- 2222/3333/4444 with A (17)
- 2222/3333/4444 with 2-4 (18)
- 2222/3333/4444 with J-K (19)
- 2222/3333/4444 with 5-T (20)
- JJJJ/QQQQ/KKKK with A (21)
- JJJJ/QQQQ/KKKK with 2-4 (22)
- JJJJ/QQQQ/KKKK with J-K (23)
- JJJJ/QQQQ/KKKK with 5-T (24)
- 5555-TTTT (25)
startTime <- proc.time()
# Create the 52c5 hands
aHands <- t(combn(1:52, 5))
str(aHands)## int [1:2598960, 1:5] 1 1 1 1 1 1 1 1 1 1 ...proc.time() - startTime## user system elapsed
## 2.65 0.03 2.72findTypes <- function (aHands, retAll=FALSE) {
# Find the ranks and suits
aRanks <- 1 + (aHands-1) %% 13
aSuits <- (aHands-1) %/% 13
# Find the flushes
aFlush <- aSuits[, 1] == aSuits[, 5]
# Find the straights
strMatrix <- matrix(data=0L, nrow=13, ncol=10)
strMatrix[c(1, 10, 11, 12, 13), 1] <- 1L
for (intCtr in 1:9) { strMatrix[intCtr:(intCtr+4), intCtr+1] <- 1L }
aRankCount <- matrix(data=-1L, nrow=choose(52, 5), ncol=13)
for (intCtr in 1:13) { aRankCount[, intCtr] <- rowSums(aRanks == intCtr) }
# Find max and count of ranks (sufficient to determine quads, full houses, trips, two pair, and pair)
aQuads <- rowSums(aRankCount == 4)
aTrips <- rowSums(aRankCount == 3)
aPairs <- rowSums(aRankCount == 2)
aStraight <- rowSums( ((aRankCount == 1) %*% strMatrix) == 5)
# Default is that a hand has nothing
aType <- rep(0L, choose(52, 5))
# Declare types for mainline (RF, SF, FH, FL, ST, 3K, 2P)
aType[aFlush == 1 & aStraight == 1 & aRankCount[, 1] == 1 &
aRankCount[, 13] == 1] <- 1 # Royal Flush
aType[aFlush == 1 & aStraight == 1 &
(aRankCount[, 1] == 0 | aRankCount[, 13] == 0)] <- 2 # Straight Flush
aType[aTrips == 1 & aPairs == 1] <- 3 # Full House
aType[aFlush == 1 & aStraight == 0] <- 4 # Flush
aType[aFlush == 0 & aStraight == 1] <- 5 # Straight
aType[aTrips == 1 & aPairs == 0] <- 6 # Trips
aType[aPairs == 2] <- 7 # Two Pair
# Declare types for pairs
aType[aTrips == 0 & aPairs == 1 & aRankCount[, 1] == 2] <- 8 # Pair Aces
aType[aTrips == 0 & aPairs == 1 & aRankCount[, 13] == 2] <- 9 # Pair Kings
aType[aTrips == 0 & aPairs == 1 & aRankCount[, 12] == 2] <- 10 # Pair Queens
aType[aTrips == 0 & aPairs == 1 & aRankCount[, 11] == 2] <- 11 # Pair Jacks
aType[aTrips == 0 & aPairs == 1 & aRankCount[, 10] == 2] <- 12 # Pair Tens
aType[aTrips == 0 & aPairs == 1 & !(aType %in% c(8, 9, 10, 11, 12))] <- 13 # Pair 22-99
# Declare types for quads
quadSubset <- aRankCount[aQuads == 1, ]
quadType <- apply(quadSubset, 1, FUN=function(x) { c(which(x == 4), which(x == 1)) } )
quadScore <- rep(-1L, ncol(quadType))
quadScore[quadType[1, ] == 1 & quadType[2, ] %in% c(2, 3, 4)] <- 14 ## AAAA with 2-4
quadScore[quadType[1, ] == 1 & quadType[2, ] %in% c(11, 12, 13)] <- 15 ## AAAA with J-K
quadScore[quadType[1, ] == 1 & quadType[2, ] %in% c(5, 6, 7, 8, 9, 10)] <- 16 ## AAAA with 5-T
quadScore[quadType[1, ] %in% c(2, 3, 4) &
quadType[2, ] %in% c(1)] <- 17 ## 2222/3333/4444 with A
quadScore[quadType[1, ] %in% c(2, 3, 4) &
quadType[2, ] %in% c(2, 3, 4)] <- 18 ## 2222/3333/4444 with 2-4
quadScore[quadType[1, ] %in% c(2, 3, 4) &
quadType[2, ] %in% c(11, 12, 13)] <- 19 ## 2222/3333/4444 with J-K
quadScore[quadType[1, ] %in% c(2, 3, 4) &
quadType[2, ] %in% c(5, 6, 7, 8, 9, 10)] <- 20 ## 2222/3333/4444 with 5-T
quadScore[quadType[1, ] %in% c(11, 12, 13) &
quadType[2, ] %in% c(1)] <- 21 ## JJJJ/QQQQ/KKKK with A
quadScore[quadType[1, ] %in% c(11, 12, 13) &
quadType[2, ] %in% c(2, 3, 4)] <- 22 ## JJJJ/QQQQ/KKKK with 2-4
quadScore[quadType[1, ] %in% c(11, 12, 13) &
quadType[2, ] %in% c(11, 12, 13)] <- 23 ## JJJJ/QQQQ/KKKK with J-K
quadScore[quadType[1, ] %in% c(11, 12, 13) &
quadType[2, ] %in% c(5, 6, 7, 8, 9, 10)] <- 24 ## JJJJ/QQQQ/KKKK with 5-T
quadScore[quadType[1, ] %in% c(5, 6, 7, 8, 9, 10)] <- 25 ## 5555/6666/7777/8888/9999/TTTT with any
# Populate quad results in to aType
aType[aQuads == 1] <- quadScore
data.frame(type=aType) %>% group_by(type) %>% summarize(ct=n()) %>% print.data.frame()
if (retAll) {
list(aType=aType,
aRankCount=aRankCount,
aRanks=aRanks,
aSuits=aSuits,
quadSubset=quadSubset,
quadType=quadType,
aFlush=aFlush,
aPairs=aPairs,
aQuads=aQuads,
aStraight=aStraight,
aTrips=aTrips
)
} else {
list(aType=aType)
}
}
listType <- findTypes(aHands=aHands, retAll=FALSE)## type ct
## 1 0 1302540
## 2 1 4
## 3 2 36
## 4 3 3744
## 5 4 5108
## 6 5 10200
## 7 6 54912
## 8 7 123552
## 9 8 84480
## 10 9 84480
## 11 10 84480
## 12 11 84480
## 13 12 84480
## 14 13 675840
## 15 14 12
## 16 15 12
## 17 16 24
## 18 17 12
## 19 18 24
## 20 19 36
## 21 20 72
## 22 21 12
## 23 22 36
## 24 23 24
## 25 24 72
## 26 25 288aType <- listType$aType
proc.time() - startTime## user system elapsed
## 10.32 1.40 12.06Further, each starting hand is assigned indices for keep0/discard5 down to keep5/discard0 . Note that hand types have not yet been converted to scores; this is simply the step for finding the relevant indices (cached for run-time optimization):
startTime <- proc.time()
getIndices <- function(nKeep, keyFun) {
mtxKeep <- combn(1:5, nKeep)
retResults <- matrix(data=-1L, nrow=nrow(aHands), ncol=ncol(mtxKeep))
for (intCtr in 1:ncol(mtxKeep)) {
thisKey <- mtxKeep[, intCtr, drop=TRUE]
thisList <- lapply(seq_along(thisKey), FUN=function(x) { aHands[, thisKey[x]] } )
if (length(thisList) == 5) {
retResults[, intCtr] <- keyFun(thisList[[1]], thisList[[2]], thisList[[3]],
thisList[[4]], thisList[[5]]
)
} else if (length(thisList) == 4) {
retResults[, intCtr] <- keyFun(thisList[[1]], thisList[[2]],
thisList[[3]], thisList[[4]]
)
} else if (length(thisList) == 3) {
retResults[, intCtr] <- keyFun(thisList[[1]], thisList[[2]], thisList[[3]])
} else if (length(thisList) == 2) {
retResults[, intCtr] <- keyFun(thisList[[1]], thisList[[2]])
} else if (length(thisList) == 1) {
retResults[, intCtr] <- keyFun(thisList[[1]])
} else { stop(paste0("Incorrect list length: ", length(thisList))) }
}
# Pass back the outcome
retResults
}
mtxIndices <- matrix(data=-1L, nrow=nrow(aHands), ncol=32)
# Populate the keep-all
mtxIndices[, 1] <- getIndices(nKeep=5, keyFun=idxCard5)
proc.time() - startTime## user system elapsed
## 1.37 0.17 1.55# Populate the keep-four
mtxIndices[, 2:6] <- getIndices(nKeep=4, keyFun=idxCard4)
proc.time() - startTime## user system elapsed
## 3.45 0.64 4.11# Populate the keep-three
mtxIndices[, 7:16] <- getIndices(nKeep=3, keyFun=idxCard3)
proc.time() - startTime## user system elapsed
## 6.71 1.40 8.13# Populate the keep-two
mtxIndices[, 17:26] <- getIndices(nKeep=2, keyFun=idxCard2)
proc.time() - startTime## user system elapsed
## 9.20 1.84 11.08# Populate the keep-one
mtxIndices[, 27:31] <- getIndices(nKeep=1, keyFun=idxCard1)
proc.time() - startTime## user system elapsed
## 9.76 1.87 11.67# Populate the keep-zero
mtxIndices[, 32] <- 0L
proc.time() - startTime## user system elapsed
## 9.80 1.87 11.70The next step creates the 134,459 non-duplicate starting hands possible (e.g., Ad Kh Tc 9c 3d is the same as As Kh Td 9d 3s), and assigns each a weighting based on how much duplication it covers.
This is copied from v004/v005 which was adapted heavily from clever thinking at http://wizardofodds.com/games/video-poker/methodology/, using in order:
- Four of a Kind (all that matters is what is the rank of the quad/kicker)
- Full House (need to know ranks for A full of B, as well as whether B contains the fourth suit or not)
- Trips (singletons can be all of fourth suit, one match and one fourth suit, no fourth suit/same, or no fourth suit/different)
- Two Pair (suits matter for how much is in common between the two pairs, as well as the singleton)
- Pair (many combinations for suits of the singletons)
- Nothing (suits matter a great deal!)
This component is cached for run-time performance:
startTime <- proc.time()
# Quads are simple - there are 13 possible quads and 12 possible kickers
# Each hand can be captured once with a weight of 4 since the kicker will always match one suit
quadSmall <- matrix(data=0L, nrow=13*12, ncol=5)
quadWeight <- rep(4L, times=13*12)
curIdx <- 1
for (intCtr in 1:13) {
for (intCtr2 in (1:13)[-intCtr]) {
quadSmall[curIdx, ] <- sort(c(intCtr, intCtr+13, intCtr+26, intCtr+39, intCtr2))
curIdx <- curIdx + 1
}
}
# Full Houses are not too much more complex, though there are two suit pairing options for each
fhSmall <- matrix(data=0L, nrow=13*12*2, ncol=5)
fhWeight <- rep(12L, times=13*12*2)
curIdx <- 1
for (intCtr in 1:13) {
for (intCtr2 in (1:13)[-intCtr]) {
# First option has both pairs matching the suits of the trips
fhSmall[curIdx, ] <- sort(c(intCtr, intCtr+13, intCtr+26, intCtr2, intCtr2+13))
# Second option has one pair not matching the suits of the trips
fhSmall[curIdx+1, ] <- sort(c(intCtr, intCtr+13, intCtr+26, intCtr2, intCtr2+39))
curIdx <- curIdx + 2
}
}
# Trips become a touch more complicated
# There is weight 24 for both singletons match different trips suits
# There is weight 12 for one singleton matches and the other does not
# There is weight 12 for both singletons match the same trips suit
# There is weight 4 for both singletons match each other but not any of the trips suits
tripSmall <- matrix(data=0L, nrow=13*choose(12, 2)*5, ncol=5)
tripWeight <- rep(c(24, 12, 12, 12, 4), times=13*choose(12,2))
curIdx <- 1
for (intCtr in 1:13) {
intAvail <- (1:13)[-intCtr]
for (intCtr2 in intAvail[-length(intAvail)]) {
for (intCtr3 in intAvail[intAvail > intCtr2]) {
# First option has both singletons matching a different trips suit
tripSmall[curIdx, ] <- sort(c(intCtr, intCtr+13, intCtr+26, intCtr2, intCtr3+13))
# Second option has singleton one matching a trips suit and singleton two not
tripSmall[curIdx+1, ] <- sort(c(intCtr, intCtr+13, intCtr+26, intCtr2, intCtr3+39))
# Third option has singleton two matching a trips suit and singleton one not
tripSmall[curIdx+2, ] <- sort(c(intCtr, intCtr+13, intCtr+26, intCtr2+39, intCtr3))
# Fourth option has both singletons matching the same trips suit
tripSmall[curIdx+3, ] <- sort(c(intCtr, intCtr+13, intCtr+26, intCtr2, intCtr3))
# Fifth option has both singletons failing to match a trips suit
tripSmall[curIdx+4, ] <- sort(c(intCtr, intCtr+13, intCtr+26, intCtr2+39, intCtr3+39))
# Increment the index by 5
curIdx <- curIdx + 5
}
}
}
# Two Pair becomes even more complicated
# There is weight 12 for four suits across the two pair -- singleton matches pair #1 or pair #2
# There is weight 24 for each of one suit match across the two pair; singleton can be four suits
# There is weight 12 for the two pair having identical suits; once for the singleton matching, once for not
twoSmall <- matrix(data=0L, nrow=choose(13, 2)*11*8, ncol=5)
twoWeight <- rep(c(12, 12, 24, 24, 24, 24, 12, 12), times=choose(13, 2)*11)
curIdx <- 1
for (intCtr in 1:12) {
for (intCtr2 in (intCtr+1):13) {
for (intCtr3 in (1:13)[-c(intCtr, intCtr2)]) {
# First option has all two pair cards being different suits
twoSmall[curIdx, ] <- sort(c(intCtr, intCtr+13, intCtr2+26, intCtr2+39, intCtr3))
twoSmall[curIdx+1, ] <- sort(c(intCtr, intCtr+13, intCtr2+26, intCtr2+39, intCtr3+26))
# Second option has one matched suits in the two pair
twoSmall[curIdx+2, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr2+26, intCtr3))
twoSmall[curIdx+3, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr2+26, intCtr3+13))
twoSmall[curIdx+4, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr2+26, intCtr3+26))
twoSmall[curIdx+5, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr2+26, intCtr3+39))
# Third option has fully matched suits across the two pair
twoSmall[curIdx+6, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr2+13, intCtr3))
twoSmall[curIdx+7, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr2+13, intCtr3+26))
# Increment the index by 8
curIdx <- curIdx + 8
}
}
}
# One Pair becomes even more complicated
# The pair is (obviously) two-suited; consider them to be 1 and 2; the game is in the singletons
# Weight 12 (2): Singletons all same suit, once matching to a pair suit, and once not
# Weight 12 (3): Singletons are suited 2-1, all matching to the pairs - 112, 121, 211
# Weight 24 (3): Singletons are suited 2-1, two matching to the pairs - 113, 131, 311
# Weight 24 (3): Singletons are suited 2-1, one matching to the pairs - 133, 313, 331
# Weight 12 (3): Singletons are suited 2-1, none matching to the pairs - 344, 434, 443
# Weight 24 (3): Singletons are suited 1-1-1, two matching to the pairs - 123, 132, 312
# Weight 24 (3): Singletons are suited 1-1-1, one matching to the pairs - 134, 314, 341
pairSmall <- matrix(data=0L, nrow=13*choose(12, 3)*20, ncol=5)
pairWeight <- rep(c(12, 12, 12, 12, 12, 24, 24, 24, 24, 24, 24,
12, 12, 12, 24, 24, 24, 24, 24, 24),
times=13*choose(12, 3)
)
curIdx <- 1
for (intCtr in 1:13) {
intAvail <- (1:13)[-intCtr]
for (intCtr2 in intAvail[-c(11, 12)]) {
nextAvail <- (intCtr2+1):13
nextAvail <- nextAvail[!(nextAvail %in% c(intCtr))]
for (intCtr3 in nextAvail[-length(nextAvail)]) {
lastAvail <- (intCtr3+1):13
lastAvail <- lastAvail[!(lastAvail %in% c(intCtr))]
for (intCtr4 in lastAvail) {
# Weight 12 (2): Singletons all same suit, once matching to a pair suit, and once not
pairSmall[curIdx, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr3, intCtr4))
pairSmall[curIdx+1, ] <- sort(c(intCtr, intCtr+13, intCtr2+26, intCtr3+26, intCtr4+26))
# Weight 12 (3): Singletons are suited 2-1, all matching to the pairs - 112, 121, 211
pairSmall[curIdx+2, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr3, intCtr4+13))
pairSmall[curIdx+3, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr3+13, intCtr4))
pairSmall[curIdx+4, ] <- sort(c(intCtr, intCtr+13, intCtr2+13, intCtr3, intCtr4))
# Weight 24 (3): Singletons are suited 2-1, two matching to the pairs - 113, 131, 311
pairSmall[curIdx+5, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr3, intCtr4+26))
pairSmall[curIdx+6, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr3+26, intCtr4))
pairSmall[curIdx+7, ] <- sort(c(intCtr, intCtr+13, intCtr2+26, intCtr3, intCtr4))
# Weight 24 (3): Singletons are suited 2-1, one matching to the pairs - 133, 313, 331
pairSmall[curIdx+8, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr3+26, intCtr4+26))
pairSmall[curIdx+9, ] <- sort(c(intCtr, intCtr+13, intCtr2+26, intCtr3, intCtr4+26))
pairSmall[curIdx+10, ] <- sort(c(intCtr, intCtr+13, intCtr2+26, intCtr3+26, intCtr4))
# Weight 12 (3): Singletons are suited 2-1, none matching to the pairs - 344, 434, 443
pairSmall[curIdx+11, ] <- sort(c(intCtr, intCtr+13, intCtr2+26, intCtr3+39, intCtr4+39))
pairSmall[curIdx+12, ] <- sort(c(intCtr, intCtr+13, intCtr2+39, intCtr3+26, intCtr4+39))
pairSmall[curIdx+13, ] <- sort(c(intCtr, intCtr+13, intCtr2+39, intCtr3+39, intCtr4+26))
# Weight 24 (3): Singletons are suited 1-1-1, two matching to the pairs - 123, 132, 312
pairSmall[curIdx+14, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr3+13, intCtr4+26))
pairSmall[curIdx+15, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr3+26, intCtr4+13))
pairSmall[curIdx+16, ] <- sort(c(intCtr, intCtr+13, intCtr2+26, intCtr3, intCtr4+13))
# Weight 24 (3): Singletons are suited 1-1-1, one matching to the pairs - 134, 314, 341
pairSmall[curIdx+17, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr3+26, intCtr4+39))
pairSmall[curIdx+18, ] <- sort(c(intCtr, intCtr+13, intCtr2+26, intCtr3, intCtr4+39))
pairSmall[curIdx+19, ] <- sort(c(intCtr, intCtr+13, intCtr2+26, intCtr3+39, intCtr4))
# Increment the index by 20
curIdx <- curIdx + 20
}
}
}
}
# No Pair becomes even more complicated
# The entire game is in the suits for the singletons
# Weight 4 (1): Singletons all same suit - 11111
# Weight 12 (5): Singletons are suited 4-1 - 11112, 11121, 11211, 12111, 21111
# Weight 12 (10): Singletons are suited 3-2 - 11122, 11212, 11221, 12112, 12121,
# 12211, 21112, 21121, 21211, 22111
# Weight 24 (10): Singletons are suited 3-1-1 - 11123, 11213, 11231, 12113, 12131,
# 12311, 21113, 21131, 21311, 23111
# Weight 24 (15): Singletons are suited 2-2-1 - 11223, 12123, 12213, 11232, 12132,
# 12231, 11322, 12312, 12321, 13122,
# 13212, 13221, 31122, 31212, 31221
# Weight 24 (10): Singletons are suited 2-1-1-1 - 11234, 12134, 12314, 12341, 21134,
# 21314, 21341, 23114, 23141, 23411
noneSmall <- matrix(data=0L, nrow=choose(13, 5)*51, ncol=5)
noneWeight <- rep(c(4, 12, 12, 12, 12, 12,
12, 12, 12, 12, 12, 12, 12, 12, 12, 12,
24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
24, 24, 24, 24, 24, 24, 24, 24, 24, 24
), times=choose(13, 5)
)
mtxAdd <- matrix(data=c(0, 0, 0, 0, 0,
0, 0, 0, 0, 1,
0, 0, 0, 1, 0,
0, 0, 1, 0, 0,
0, 1, 0, 0, 0,
1, 0, 0, 0, 0,
0, 0, 0, 1, 1,
0, 0, 1, 0, 1,
0, 1, 0, 0, 1,
1, 0, 0, 0, 1,
0, 0, 1, 1, 0,
0, 1, 0, 1, 0,
1, 0, 0, 1, 0,
0, 1, 1, 0, 0,
1, 0, 1, 0, 0,
1, 1, 0, 0, 0,
0, 0, 0, 1, 2,
0, 0, 1, 0, 2,
0, 1, 0, 0, 2,
1, 0, 0, 0, 2,
0, 0, 1, 2, 0,
0, 1, 0, 2, 0,
1, 0, 0, 2, 0,
0, 1, 2, 0, 0,
1, 0, 2, 0, 0,
1, 2, 0, 0, 0,
0, 0, 1, 1, 2,
0, 1, 0, 1, 2,
1, 0, 0, 1, 2,
0, 0, 1, 2, 1,
0, 1, 0, 2, 1,
1, 0, 0, 2, 1,
0, 0, 2, 1, 1,
0, 1, 2, 0, 1,
1, 0, 2, 0, 1,
0, 2, 0, 1, 1,
0, 2, 1, 0, 1,
1, 2, 0, 0, 1,
2, 0, 0, 1, 1,
2, 0, 1, 0, 1,
2, 1, 0, 0, 1,
0, 0, 1, 2, 3,
0, 1, 0, 2, 3,
0, 1, 2, 0, 3,
0, 1, 2, 3, 0,
1, 0, 0, 2, 3,
1, 0, 2, 0, 3,
1, 0, 2, 3, 0,
1, 2, 0, 0, 3,
1, 2, 0, 3, 0,
1, 2, 3, 0, 0
) * 13, ncol=5, byrow=TRUE)
curIdx <- 1
for (intCtr in 1:9) {
for (intCtr2 in (intCtr+1):10) {
for (intCtr3 in (intCtr2+1):11) {
for (intCtr4 in (intCtr3+1):12) {
for (intCtr5 in (intCtr4+1):13) {
vecNone <- c(intCtr, intCtr2, intCtr3, intCtr4, intCtr5)
mtxNone <- matrix(data=rep(vecNone, times=51), ncol=5, byrow=TRUE)
# IMPORTANT - future classification relies on low-high sorting in each row
noneSmall[curIdx:(curIdx+50), ] <-
t(apply(mtxNone + mtxAdd, 1, FUN=sort))
curIdx <- curIdx + 51
}
}
}
}
}
proc.time() - startTime## user system elapsed
## 4.44 0.03 4.49Further, the hands and weights are integrated to a single hand matrix and a single weighting vector:
startTime <- proc.time()
cardSmall <- rbind(quadSmall, fhSmall, tripSmall, twoSmall, pairSmall, noneSmall)
cardWeight <- c(quadWeight, fhWeight, tripWeight, twoWeight, pairWeight, noneWeight)
str(cardSmall)## num [1:134459, 1:5] 1 1 1 1 1 1 1 1 1 1 ...str(cardWeight)## num [1:134459] 4 4 4 4 4 4 4 4 4 4 ...# Confirm that there are sill 52c5 hands after weighting
all.equal(sum(cardWeight), choose(52, 5))## [1] TRUE# Confirm that dimensions of hands and weight match up
all.equal(nrow(cardSmall), length(cardWeight))## [1] TRUEall.equal(ncol(cardSmall), 5)## [1] TRUE# Report the degree of space savings due to the weighting
summary(cardWeight)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 4.00 12.00 24.00 19.33 24.00 24.00# Assign the index for each cardSmall
cardIndex <- idxCard5(cardSmall[, 1], cardSmall[, 2], cardSmall[, 3],
cardSmall[, 4], cardSmall[, 5]
)
str(cardIndex)## int [1:134459] 10852 29276 46572 62787 77967 92157 105401 117742 129222 139882 ...summary(cardIndex)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1 286100 602500 704600 1085000 2008000all.equal(cardIndex, unique(cardIndex))## [1] TRUEproc.time() - startTime## user system elapsed
## 0.31 0.02 0.32The weighting allows for ~19x reduction in duplication which speeds processing time by roughly ~19x when using “no replacement” for drawing hands. This is a strong improvement in efficiency.
Scoring (apply pay table)
A function is created to convert hand types to scores:
makeScores <- function(inType, type2Score, idx) {
aScores <- type2Score$val[match(inType, idx)]
print(summary(aScores))
cat("\n")
data.frame(aScores=aScores) %>% group_by(aScores) %>% summarize(ct=n()) %>% print()
cat("\n")
aScores
}Next, a function is written to calculate each of the following, assuming that you can get back the original card(s) on the re-draw:
- Keep 4
- Keep 3
- Keep 2
- Keep 1
There is no need to calculate Keep 5 (it is already aScores) or Keep 0 (it defaults to mean(aScores) everywhere):
findEV_YesRedraw <- function(useIdx, mtxIndices, aScores) {
# Assuming re-draw of thrown cards
tmpScores <- data.frame(idx=as.vector(mtxIndices[, useIdx]),
val=rep(aScores, times=length(useIdx))
)
# This is what will be returned - mean by Index
tmpScores %>% group_by(idx) %>% summarize(ev=mean(val))
}
calcEV_YesRedraw <- function(mtxIndices, aScores) {
tmpEVkeep4 <- findEV_YesRedraw(useIdx=2:6, mtxIndices=mtxIndices, aScores=aScores)
tmpEVkeep3 <- findEV_YesRedraw(useIdx=7:16, mtxIndices=mtxIndices, aScores=aScores)
tmpEVkeep2 <- findEV_YesRedraw(useIdx=17:26, mtxIndices=mtxIndices, aScores=aScores)
tmpEVkeep1 <- findEV_YesRedraw(useIdx=27:31, mtxIndices=mtxIndices, aScores=aScores)
print(summary(tmpEVkeep4$ev)); cat("\n")
print(summary(tmpEVkeep3$ev)); cat("\n")
print(summary(tmpEVkeep2$ev)); cat("\n")
print(summary(tmpEVkeep1$ev)); cat("\n\n")
print(sum(tmpEVkeep4$idx != 1:choose(52,4)))
print(sum(tmpEVkeep3$idx != 1:choose(52,3)))
print(sum(tmpEVkeep2$idx != 1:choose(52,2)))
print(sum(tmpEVkeep1$idx != 1:choose(52,1)))
list(tmpEVkeep4=tmpEVkeep4, tmpEVkeep3=tmpEVkeep3,
tmpEVkeep2=tmpEVkeep2, tmpEVkeep1=tmpEVkeep1
)
}The summary statistics and control totals are “as expected”, and the process takes ~8 seconds. This could be reduced to ~0.5 seconds by using a weighting that avoids redundancy. However, further effort is needed to make sure that 1) discards are never returned, and 2) optimal holds for each starting hand can be calculated.
Analysis (simulate pay table)
Next, all of the holds are run assuming you cannot re-draw discards, using the smaller database. The key elements are 1) cardSmall (actual hands), 2) cardWeight (weightings for cardSmall), and 3) cardIndex (the mapping of each hand in cardSmall to the corresponding index of aScores:
makeNoReplace <- function(aScores, cardIndex, keyList, mtxIndices) {
evSmallNoReplace <- matrix(data=0.0, nrow=length(cardIndex), ncol=32)
tmpEVkeep4 <- keyList$tmpEVkeep4
tmpEVkeep3 <- keyList$tmpEVkeep3
tmpEVkeep2 <- keyList$tmpEVkeep2
tmpEVkeep1 <- keyList$tmpEVkeep1
# Keep 5
evSmallNoReplace[, 1] <- aScores[cardIndex]
# Keep 4 (intCtr: 2 is 1234, 3 is 1235, 4 is 1245, 5 is 1345, 6 is 2345)
for (intCtr in 2:6) {
evSmallNoReplace[, intCtr] <- (48 * tmpEVkeep4$ev[mtxIndices[cardIndex, intCtr]] -
evSmallNoReplace[, 1]) / 47
}
# Keep 3 (intCtr: 7 is 123, 8 is 124, 9 is 125, 10 is 134, 11 is 135)
# Keep 3 (intCtr: 12 is 145, 13 is 234, 14 is 235, 15 is 245, 16 is 345)
# Take the EV of the 3 cards assuming stand-alone
# Subtract the EV of each of the 4 cards (3 + 1 discard) assuming stand-alone
# Add back the EV of the 5 cards assuming stand-alone
mapKeep3 <- data.frame(idx=7:16,
keep1=c(2, 2, 3, 2, 3, 4, 2, 3, 4, 5),
keep2=c(3, 4, 4, 5, 5, 5, 6, 6, 6, 6)
)
for (intCtr in 7:16) {
c1 <- mapKeep3$keep1[mapKeep3$idx == intCtr]
c2 <- mapKeep3$keep2[mapKeep3$idx == intCtr]
evSmallNoReplace[, intCtr] <- (choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, intCtr]] -
48 * tmpEVkeep4$ev[mtxIndices[cardIndex, c1]] -
48 * tmpEVkeep4$ev[mtxIndices[cardIndex, c2]] +
evSmallNoReplace[, 1]
) / choose(47, 2)
}
# Keep 2 (intCtr: 17 is 12, 18 is 13, 19 is 14, 20 is 15, 21 is 23)
# Keep 2 (intCtr: 22 is 24, 23 is 25, 24 is 34, 25 is 35, 26 is 45)
# Take the EV of the 2 cards assuming stand-alone
# Subtract the EV of each of the 3 cards (2 + 1 discard) assuming stand-alone
# add back the EV of each of the 4 cards (2 + 2 discard) assuming stand-alone
# Subtract the EV of the 5 cards assuming stand-alone
mapKeep2 <- data.frame(idx=17:26,
keep3_1=c(7, 7, 8, 9, 7, 8, 9, 10, 11, 12),
keep3_2=c(8, 10, 10, 11, 13, 13, 14, 13, 14, 15),
keep3_3=c(9, 11, 12, 12, 14, 15, 15, 16, 16, 16),
keep4_1=c(2, 2, 2, 3, 2, 2, 3, 2, 3, 4),
keep4_2=c(3, 3, 4, 4, 3, 4, 4, 5, 5, 5),
keep4_3=c(4, 5, 5, 5, 6, 6, 6, 6, 6, 6)
)
for (intCtr in 17:26) {
c31 <- mapKeep2$keep3_1[mapKeep2$idx == intCtr]
c32 <- mapKeep2$keep3_2[mapKeep2$idx == intCtr]
c33 <- mapKeep2$keep3_3[mapKeep2$idx == intCtr]
c41 <- mapKeep2$keep4_1[mapKeep2$idx == intCtr]
c42 <- mapKeep2$keep4_2[mapKeep2$idx == intCtr]
c43 <- mapKeep2$keep4_3[mapKeep2$idx == intCtr]
evSmallNoReplace[, intCtr] <- (choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, intCtr]] -
choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, c31]] -
choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, c32]] -
choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, c33]] +
choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, c41]] +
choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, c42]] +
choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, c43]] -
evSmallNoReplace[, 1]
) / choose(47, 3)
}
# Keep 1 (intCtr: 27 is 1, 28 is 2, 29 is 3, 30 is 4, 31 is 5)
# Take the EV of the 1 card assuming stand-alone
# Subtract the EV of the 2 cards (1 + 1 discard) assuming stand-alone
# Add back the EV of each of the 3 cards (1 + 2 discard) assuming stand-alone
# Subtract the EV of each of the 4 cards (1 + 3 discard) assuming stand-alone
# Add back the EV of the 5 cards assuming stand-alone
mapKeep1 <- data.frame(idx=27:31,
keep2_1=c(17, 17, 18, 19, 20),
keep2_2=c(18, 21, 21, 22, 23),
keep2_3=c(19, 22, 24, 24, 25),
keep2_4=c(20, 23, 25, 26, 26),
keep3_1=c(7, 7, 7, 8, 9),
keep3_2=c(8, 8, 10, 10, 11),
keep3_3=c(9, 9, 11, 12, 12),
keep3_4=c(10, 13, 13, 13, 14),
keep3_5=c(11, 14, 14, 15, 15),
keep3_6=c(12, 15, 16, 16, 16),
keep4_1=c(2, 2, 2, 2, 3),
keep4_2=c(3, 3, 3, 4, 4),
keep4_3=c(4, 4, 5, 5, 5),
keep4_4=c(5, 6, 6, 6, 6)
)
for (intCtr in 27:31) {
c21 <- mapKeep1$keep2_1[mapKeep1$idx == intCtr]
c22 <- mapKeep1$keep2_2[mapKeep1$idx == intCtr]
c23 <- mapKeep1$keep2_3[mapKeep1$idx == intCtr]
c24 <- mapKeep1$keep2_4[mapKeep1$idx == intCtr]
c31 <- mapKeep1$keep3_1[mapKeep1$idx == intCtr]
c32 <- mapKeep1$keep3_2[mapKeep1$idx == intCtr]
c33 <- mapKeep1$keep3_3[mapKeep1$idx == intCtr]
c34 <- mapKeep1$keep3_4[mapKeep1$idx == intCtr]
c35 <- mapKeep1$keep3_5[mapKeep1$idx == intCtr]
c36 <- mapKeep1$keep3_6[mapKeep1$idx == intCtr]
c41 <- mapKeep1$keep4_1[mapKeep1$idx == intCtr]
c42 <- mapKeep1$keep4_2[mapKeep1$idx == intCtr]
c43 <- mapKeep1$keep4_3[mapKeep1$idx == intCtr]
c44 <- mapKeep1$keep4_4[mapKeep1$idx == intCtr]
evSmallNoReplace[, intCtr] <- (choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, intCtr]] -
choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, c21]] -
choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, c22]] -
choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, c23]] -
choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, c24]] +
choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, c31]] +
choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, c32]] +
choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, c33]] +
choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, c34]] +
choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, c35]] +
choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, c36]] -
choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, c41]] -
choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, c42]] -
choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, c43]] -
choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, c44]] +
evSmallNoReplace[, 1]
) / choose(47, 4)
}
# Keep 0 (column 32)
# Take the EV of the 0 card assuming stand-alone
# Subtract the EV of each 1 card (0 + 1 discard) assuming stand-alone
# Add back the EV of each of the 2 cards (0 + 2 discard) assuming stand-alone
# Subtract the EV of each of the 3 cards (0 + 3 discard) assuming stand-alone
# Add back the EV of each of the 4 cards (0 + 4 discard) assuming stand-alone
# Subtract the EV of the 5 cards assuming stand-alone
evSmallNoReplace[, 32] <- (choose(52, 5) * mean(aScores) -
choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, 31]] -
choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, 30]] -
choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, 29]] -
choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, 28]] -
choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, 27]] +
choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 26]] +
choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 25]] +
choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 24]] +
choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 23]] +
choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 22]] +
choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 21]] +
choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 20]] +
choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 19]] +
choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 18]] +
choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 17]] -
choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 16]] -
choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 15]] -
choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 14]] -
choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 13]] -
choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 12]] -
choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 11]] -
choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 10]] -
choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 9]] -
choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 8]] -
choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 7]] +
choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, 6]] +
choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, 5]] +
choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, 4]] +
choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, 3]] +
choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, 2]] -
evSmallNoReplace[, 1]
) / choose(47, 5)
evSmallNoReplace
}The optimal holds and aggregate EV are the assessed:
descStat <- function(tempSmallMax, cardWeight) {
# Calculate descriptive statistics
print(summary(rep(tempSmallMax[1, ], times=cardWeight))); cat("\n")
print(1 + mean(rep(tempSmallMax[1, ], times=cardWeight))); cat("\n")
hist(rep(tempSmallMax[2, ], times=cardWeight), breaks=0:33, main="Index for Cards Held",
xlab="1 (hold 5) --- 2-6 (hold 4: 1234, 1235, 1245, 1345, 2345) -- etc. -- 32 (hold 0)",
col=c( rep("blue", 1), rep("lightblue", 5), rep("orange", 10),
rep("lightgreen", 10), rep("red", 5), rep("black", 1)
)
)
newSmallCutIdx <- cut(tempSmallMax[2, ],
breaks=c(0.5, 1.5, 6.5, 16.5, 26.5, 31.5, 32.5)
)
data.frame(newType=rep(newSmallCutIdx, times=cardWeight)) %>%
group_by(newType) %>% summarize(ct=n())
}The control totals and expected values were as expected, and the program runs in ~10 seconds!
Next, the scoring and analysis are converted to functions, with the simulation re-run:
# Simulate a specific pay-table
simGame <- function(aT=aType, h2S=hnd2Score, gameI=gameIndex, mtxI=mtxIndices,
cardI=cardIndex, cardW=cardWeight, startT=startTime,
grTitle="Simulation Results", allOut=FALSE
) {
# Convert to Scores
aScores <- makeScores(inType=aT, type2Score=h2S, idx=gameI)
# Get the EV assuming re-draws are allowed
keyList <- calcEV_YesRedraw(mtxIndices=mtxI, aScores=aScores)
# Make the EV grid for "no replacement"
evSmallNoReplace <- makeNoReplace(aScores=aScores, cardIndex=cardI,
keyList=keyList, mtxIndices=mtxI
)
# Find the best holds
tempSmallMax <- apply(evSmallNoReplace, 1, FUN=function(x) { c(max(x), which.max(x)) } )
descStat(tempSmallMax=tempSmallMax, cardWeight=cardW)
if (allOut) {
return(list(tempSmallMax=tempSmallMax,
evSmallNoReplace=evSmallNoReplace,
aScores=aScores,
keyList=keyList
)
)
} else {
return(list(tempSmallMax=tempSmallMax,
evSmallNoReplace=evSmallNoReplace
)
)
}
}
# Use one pay-table on a different game
simPayTable <- function(useEV, useHold, useWeights) {
# Confirm dimensions
if (length(useHold) != nrow(useEV) | length(useHold) != length(useWeights)) {
print(str(useEV))
print(str(useHold))
print(str(useWeights))
stop("Error: Inconsistent dimensions for simulation; check and re-try")
}
# useHold (vector 134,459) determines which column to use
# for each respective row of useEV (matrix 134,459 x 32)
newEV <- useEV[ cbind(1:nrow(useEV), useHold) ]
print(summary(rep(newEV, times=useWeights)))
return(newEV)
}The simulations take ~10 seconds each, and the results are cached for quicker run times:
startTime <- proc.time()
# Run the game for JB 96
gameIndex <- 0:25
jb96hnd2Score <- data.frame(idx=gameIndex, val=c( -1,
799, 49, 8, 5, 3,
2, 1, 0, 0, 0,
0, -1, -1, 24, 24,
24, 24, 24, 24, 24,
24, 24, 24, 24, 24
)
)
jb96List <- simGame(h2S=jb96hnd2Score)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -1.0000 -1.0000 -0.6631 -1.0000 799.0000
##
## # A tibble: 10 × 2
## aScores ct
## <dbl> <int>
## 1 -1 2062860
## 2 0 337920
## 3 1 123552
## 4 2 54912
## 5 3 10200
## 6 5 5108
## 7 8 3744
## 8 24 624
## 9 49 36
## 10 799 4
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -0.9375 -0.8750 -0.6631 -0.6250 24.0000
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.9107 -0.8138 -0.8138 -0.6631 -0.6624 3.2650
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.8122 -0.7731 -0.6898 -0.6631 -0.6506 0.5143
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.7177 -0.7049 -0.7049 -0.6631 -0.5668 -0.5582
##
##
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6426 -0.5175 -0.1763 -0.0046 0.1489 799.0000
##
## [1] 0.995439
proc.time() - startTime## user system elapsed
## 9.06 0.94 10.28# Run the game for JB 85
gameIndex <- 0:25
jb85hnd2Score <- data.frame(idx=gameIndex, val=c( -1,
799, 49, 7, 4, 3,
2, 1, 0, 0, 0,
0, -1, -1, 24, 24,
24, 24, 24, 24, 24,
24, 24, 24, 24, 24
)
)
jb85List <- simGame(h2S=jb85hnd2Score)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -1.0000 -1.0000 -0.6665 -1.0000 799.0000
##
## # A tibble: 10 × 2
## aScores ct
## <dbl> <int>
## 1 -1 2062860
## 2 0 337920
## 3 1 123552
## 4 2 54912
## 5 3 10200
## 6 4 5108
## 7 7 3744
## 8 24 624
## 9 49 36
## 10 799 4
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -0.9375 -0.8750 -0.6665 -0.6250 24.0000
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.9107 -0.8138 -0.8138 -0.6665 -0.6624 3.2040
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.8132 -0.7740 -0.6907 -0.6665 -0.6515 0.5045
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.7211 -0.7083 -0.7083 -0.6665 -0.5702 -0.5616
##
##
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6458 -0.5219 -0.1865 -0.0270 -0.0426 799.0000
##
## [1] 0.9729843
proc.time() - startTime## user system elapsed
## 16.38 1.69 18.63# Nothing
# RF, SF, FH, FL, ST
# Trips, 2P, AA, KK, QQ
# JJ, TT, 22-99, AAAA 2-4, AAAA J-K
# AAAA 5-T, 2222/3333/4444 A, 2222/3333/4444 2-4, 2222/3333/4444 J-K, 2222/3333/4444 5-T
# JJJJ/QQQQ/KKKK A, JJJJ/QQQQ/KKKK 2-4, JJJJ/QQQQ/KKKK J-K, JJJJ/QQQQ/KKKK 5-T, 5555-TTTT
# Run the game for BP 85
gameIndex <- 0:25
bp85hnd2Score <- data.frame(idx=gameIndex, val=c( -1,
799, 49, 7, 4, 3,
2, 1, 0, 0, 0,
0, -1, -1, 79, 79,
79, 39, 39, 39, 39,
24, 24, 24, 24, 24
)
)
bp85List <- simGame(h2S=bp85hnd2Score)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -1.0000 -1.0000 -0.6647 -1.0000 799.0000
##
## # A tibble: 12 × 2
## aScores ct
## <dbl> <int>
## 1 -1 2062860
## 2 0 337920
## 3 1 123552
## 4 2 54912
## 5 3 10200
## 6 4 5108
## 7 7 3744
## 8 24 432
## 9 39 144
## 10 49 36
## 11 79 48
## 12 799 4
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -0.9375 -0.8750 -0.6647 -0.6250 79.0000
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.9107 -0.8138 -0.8138 -0.6647 -0.6624 5.4490
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.8132 -0.7732 -0.6907 -0.6647 -0.6515 0.6392
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.7178 -0.7079 -0.7079 -0.6647 -0.5698 -0.5594
##
##
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6434 -0.5183 -0.1865 -0.0083 -0.0426 799.0000
##
## [1] 0.9916597
proc.time() - startTime## user system elapsed
## 23.88 2.37 26.88# Run the game for DDB 96
gameIndex <- 0:25
ddb96hnd2Score <- data.frame(idx=gameIndex, val=c( -1,
799, 49, 8, 5, 3,
2, 0, 0, 0, 0,
0, -1, -1, 399, 159,
159, 159, 159, 79, 79,
49, 49, 49, 49, 49
)
)
ddb96List <- simGame(h2S=ddb96hnd2Score)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -1.0000 -1.0000 -0.6988 -1.0000 799.0000
##
## # A tibble: 11 × 2
## aScores ct
## <dbl> <int>
## 1 -1 2062860
## 2 0 461472
## 3 2 54912
## 4 3 10200
## 5 5 5108
## 6 8 3744
## 7 49 468
## 8 79 108
## 9 159 72
## 10 399 12
## 11 799 4
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -0.9375 -0.8750 -0.6988 -0.7500 219.0000
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.9337 -0.8367 -0.8367 -0.6988 -0.6854 11.2200
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.8501 -0.8094 -0.7277 -0.6988 -0.6885 0.8302
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.7473 -0.7456 -0.7430 -0.6988 -0.6075 -0.5743
##
##
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6770 -0.5414 -0.2668 -0.0102 0.1489 799.0000
##
## [1] 0.9898078
proc.time() - startTime## user system elapsed
## 30.84 3.14 34.77# Run the game for TDB 97
gameIndex <- 0:25
tdb97hnd2Score <- data.frame(idx=gameIndex, val=c( -1,
799, 49, 8, 6, 3,
1, 0, 0, 0, 0,
0, -1, -1, 799, 159,
159, 399, 399, 79, 79,
49, 49, 49, 49, 49
)
)
tdb97List <- simGame(h2S=tdb97hnd2Score)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -1.0000 -1.0000 -0.7128 -1.0000 799.0000
##
## # A tibble: 11 × 2
## aScores ct
## <dbl> <int>
## 1 -1 2062860
## 2 0 461472
## 3 1 54912
## 4 3 10200
## 5 6 5108
## 6 8 3744
## 7 49 468
## 8 79 108
## 9 159 36
## 10 399 36
## 11 799 16
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -0.9375 -0.8750 -0.7128 -0.7917 319.0000
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.9413 -0.8444 -0.8444 -0.7128 -0.6930 14.4100
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.8658 -0.8136 -0.7434 -0.7128 -0.6844 0.9673
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.7648 -0.7648 -0.7514 -0.7128 -0.6266 -0.5714
##
##
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6933 -0.5364 -0.3811 -0.0042 0.3317 799.0000
##
## [1] 0.9957781
proc.time() - startTime## user system elapsed
## 37.81 3.85 42.51# Run the game for TDB 96
gameIndex <- 0:25
tdb96hnd2Score <- data.frame(idx=gameIndex, val=c( -1,
799, 49, 8, 5, 3,
1, 0, 0, 0, 0,
0, -1, -1, 799, 159,
159, 399, 399, 79, 79,
49, 49, 49, 49, 49
)
)
tdb96List <- simGame(h2S=tdb96hnd2Score)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -1.0000 -1.0000 -0.7147 -1.0000 799.0000
##
## # A tibble: 11 × 2
## aScores ct
## <dbl> <int>
## 1 -1 2062860
## 2 0 461472
## 3 1 54912
## 4 3 10200
## 5 5 5108
## 6 8 3744
## 7 49 468
## 8 79 108
## 9 159 36
## 10 399 36
## 11 799 16
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -0.9375 -0.8750 -0.7147 -0.7917 319.0000
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.9413 -0.8444 -0.8444 -0.7147 -0.6930 14.4100
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.8658 -0.8138 -0.7434 -0.7147 -0.6929 0.9673
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.7667 -0.7667 -0.7534 -0.7147 -0.6286 -0.5734
##
##
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6952 -0.5391 -0.3811 -0.0185 0.1489 799.0000
##
## [1] 0.98154
proc.time() - startTime## user system elapsed
## 45.03 4.67 50.70# Run the game for BPD 96
gameIndex <- 0:25
bpd96hnd2Score <- data.frame(idx=gameIndex, val=c( -1,
799, 49, 8, 5, 3,
2, 0, 0, 0, 0,
0, -1, -1, 79, 79,
79, 79, 79, 79, 79,
79, 79, 79, 79, 79
)
)
bpd96List <- simGame(h2S=bpd96hnd2Score)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -1.0000 -1.0000 -0.6975 -1.0000 799.0000
##
## # A tibble: 9 × 2
## aScores ct
## <dbl> <int>
## 1 -1 2062860
## 2 0 461472
## 3 2 54912
## 4 3 10200
## 5 5 5108
## 6 8 3744
## 7 49 36
## 8 79 624
## 9 799 4
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -0.9375 -0.8750 -0.6975 -0.7500 79.0000
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.9337 -0.8367 -0.8367 -0.6975 -0.6854 5.5100
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.8470 -0.8079 -0.7246 -0.6975 -0.6854 0.4873
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.7520 -0.7392 -0.7392 -0.6975 -0.6011 -0.5926
##
##
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6770 -0.5528 -0.1835 -0.0036 0.1489 799.0000
##
## [1] 0.9964171
proc.time() - startTime## user system elapsed
## 52.59 5.43 59.25The various games are then assessed, including implications on EV when using strategy A on game B:
startTime <- proc.time()
# Find the EV for using the JB 96 strategy on the JB 85 game
sum(jb85List$tempSmallMax[2,] != jb96List$tempSmallMax[2,])## [1] 597sum((jb85List$tempSmallMax[2,] != jb96List$tempSmallMax[2,]) * cardWeight)## [1] 10956jb85EV_jb96Holds <- simPayTable(useEV=jb85List$evSmallNoReplace,
useHold=jb96List$tempSmallMax[2, ],
useWeights=cardWeight
)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6458 -0.5219 -0.1865 -0.0271 -0.0426 799.00001 + mean(rep(jb85EV_jb96Holds, times=cardWeight))## [1] 0.9729123mean(rep(jb85EV_jb96Holds - jb85List$tempSmallMax[1, ], times=cardWeight))## [1] -7.201211e-05proc.time() - startTime## user system elapsed
## 0.71 0.07 0.78# Find the EV for using the JB 96 strategy on the BP 85 game
sum(bp85List$tempSmallMax[2,] != jb96List$tempSmallMax[2,])## [1] 721sum((bp85List$tempSmallMax[2,] != jb96List$tempSmallMax[2,]) * cardWeight)## [1] 13728bp85EV_jb96Holds <- simPayTable(useEV=bp85List$evSmallNoReplace,
useHold=jb96List$tempSmallMax[2, ],
useWeights=cardWeight
)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6434 -0.5184 -0.1865 -0.0084 -0.0426 799.00001 + mean(rep(bp85EV_jb96Holds, times=cardWeight))## [1] 0.9915825mean(rep(bp85EV_jb96Holds - bp85List$tempSmallMax[1, ], times=cardWeight))## [1] -7.724575e-05proc.time() - startTime## user system elapsed
## 1.02 0.16 1.22# Find the EV for using the JB 96 strategy on the DDB 96 game
sum(ddb96List$tempSmallMax[2,] != jb96List$tempSmallMax[2,])## [1] 13077sum((ddb96List$tempSmallMax[2,] != jb96List$tempSmallMax[2,]) * cardWeight)## [1] 281580ddb96EV_jb96Holds <- simPayTable(useEV=ddb96List$evSmallNoReplace,
useHold=jb96List$tempSmallMax[2, ],
useWeights=cardWeight
)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6770 -0.5507 -0.2668 -0.0156 0.1489 799.00001 + mean(rep(ddb96EV_jb96Holds, times=cardWeight))## [1] 0.9844227d_jb96_ddb96 <- ddb96EV_jb96Holds - ddb96List$tempSmallMax[1, ]
mean(rep(d_jb96_ddb96, times=cardWeight))## [1] -0.005385149data.frame(dEV=rep(d_jb96_ddb96, times=cardWeight)) %>%
mutate(rndDelta=round(dEV, 2)) %>%
group_by(rndDelta) %>%
summarize(ct=n(), evLoss=100 * sum(rndDelta)/sum(cardWeight))## # A tibble: 14 × 3
## rndDelta ct evLoss
## <dbl> <int> <dbl>
## 1 -61.28 36 -0.084883184
## 2 -20.43 108 -0.084897036
## 3 -3.72 216 -0.030916982
## 4 -3.27 72 -0.009059008
## 5 -0.25 10368 -0.099732201
## 6 -0.24 3888 -0.035903592
## 7 -0.22 3888 -0.032911626
## 8 -0.21 864 -0.006981254
## 9 -0.08 696 -0.002142395
## 10 -0.04 756 -0.001163542
## 11 -0.03 12492 -0.014419614
## 12 -0.02 113508 -0.087348786
## 13 -0.01 121344 -0.046689445
## 14 0.00 2330724 0.000000000proc.time() - startTime## user system elapsed
## 1.70 0.21 1.95# Find the EV for using the DDB 96 strategy on the TDB 97 game
sum(tdb97List$tempSmallMax[2,] != ddb96List$tempSmallMax[2,])## [1] 15421sum((tdb97List$tempSmallMax[2,] != ddb96List$tempSmallMax[2,]) * cardWeight)## [1] 273012tdb97EV_ddb96Holds <- simPayTable(useEV=tdb97List$evSmallNoReplace,
useHold=ddb96List$tempSmallMax[2, ],
useWeights=cardWeight
)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6933 -0.5364 -0.3811 -0.0151 0.3317 799.00001 + mean(rep(tdb97EV_ddb96Holds, times=cardWeight))## [1] 0.9849045d_ddb96_tdb97 <- tdb97EV_ddb96Holds - tdb97List$tempSmallMax[1, ]
mean(rep(d_ddb96_tdb97, times=cardWeight))## [1] -0.0108736data.frame(dEV=rep(d_ddb96_tdb97, times=cardWeight)) %>%
mutate(rndDelta=round(dEV, 2)) %>%
group_by(rndDelta) %>%
summarize(ct=n(), evLoss=100 * sum(rndDelta)/sum(cardWeight)) %>%
print.data.frame()## rndDelta ct evLoss
## 1 -4.35 192 -0.0321359313
## 2 -4.20 72 -0.0116354234
## 3 -3.76 1728 -0.2499953828
## 4 -2.21 576 -0.0489795918
## 5 -1.91 5184 -0.3809770062
## 6 -1.77 216 -0.0147104996
## 7 -0.31 648 -0.0077292455
## 8 -0.18 828 -0.0057346015
## 9 -0.16 576 -0.0035460338
## 10 -0.15 2376 -0.0137131776
## 11 -0.14 120 -0.0006464124
## 12 -0.13 180 -0.0009003601
## 13 -0.12 4572 -0.0211099825
## 14 -0.11 144 -0.0006094746
## 15 -0.10 492 -0.0018930649
## 16 -0.09 1356 -0.0046957244
## 17 -0.08 1848 -0.0056884292
## 18 -0.07 1176 -0.0031674208
## 19 -0.06 7128 -0.0164558131
## 20 -0.05 49392 -0.0950226244
## 21 -0.04 41652 -0.0641056423
## 22 -0.03 38208 -0.0441037954
## 23 -0.02 62880 -0.0483885862
## 24 -0.01 32556 -0.0125265491
## 25 0.00 2344860 0.0000000000proc.time() - startTime## user system elapsed
## 2.37 0.30 2.71# Find the EV for using the DDB 96 strategy on the TDB 96 game
sum(tdb96List$tempSmallMax[2,] != ddb96List$tempSmallMax[2,])## [1] 7376sum((tdb96List$tempSmallMax[2,] != ddb96List$tempSmallMax[2,]) * cardWeight)## [1] 134820tdb96EV_ddb96Holds <- simPayTable(useEV=tdb96List$evSmallNoReplace,
useHold=ddb96List$tempSmallMax[2, ],
useWeights=cardWeight
)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6952 -0.5391 -0.3811 -0.0264 0.1489 799.00001 + mean(rep(tdb96EV_ddb96Holds, times=cardWeight))## [1] 0.973546d_ddb96_tdb96 <- tdb96EV_ddb96Holds - tdb96List$tempSmallMax[1, ]
mean(rep(d_ddb96_tdb96, times=cardWeight))## [1] -0.007994002data.frame(dEV=rep(d_ddb96_tdb96, times=cardWeight)) %>%
mutate(rndDelta=round(dEV, 2)) %>%
group_by(rndDelta) %>%
summarize(ct=n(), evLoss=100 * sum(rndDelta)/sum(cardWeight)) %>%
print.data.frame()## rndDelta ct evLoss
## 1 -4.35 192 -3.213593e-02
## 2 -4.20 72 -1.163542e-02
## 3 -3.76 1728 -2.499954e-01
## 4 -2.21 576 -4.897959e-02
## 5 -1.91 5184 -3.809770e-01
## 6 -1.77 216 -1.471050e-02
## 7 -0.31 648 -7.729246e-03
## 8 -0.11 72 -3.047373e-04
## 9 -0.10 120 -4.617232e-04
## 10 -0.09 180 -6.233263e-04
## 11 -0.08 888 -2.733401e-03
## 12 -0.07 288 -7.756949e-04
## 13 -0.06 6852 -1.581864e-02
## 14 -0.05 12 -2.308616e-05
## 15 -0.04 36 -5.540678e-05
## 16 -0.03 2736 -3.158186e-03
## 17 -0.02 4692 -3.610675e-03
## 18 -0.01 55860 -2.149321e-02
## 19 0.00 2518608 0.000000e+00proc.time() - startTime## user system elapsed
## 2.98 0.41 3.43# Find the EV for using the DDB 96 strategy on the JB 96 game
sum(jb96List$tempSmallMax[2,] != ddb96List$tempSmallMax[2,])## [1] 13077sum((jb96List$tempSmallMax[2,] != ddb96List$tempSmallMax[2,]) * cardWeight)## [1] 281580jb96EV_ddb96Holds <- simPayTable(useEV=jb96List$evSmallNoReplace,
useHold=ddb96List$tempSmallMax[2, ],
useWeights=cardWeight
)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6596 -0.5204 -0.1763 -0.0149 0.1489 799.00001 + mean(rep(jb96EV_ddb96Holds, times=cardWeight))## [1] 0.9851137d_ddb96_jb96 <- jb96EV_ddb96Holds - jb96List$tempSmallMax[1, ]
mean(rep(d_ddb96_jb96, times=cardWeight))## [1] -0.01032537data.frame(dEV=rep(d_ddb96_jb96, times=cardWeight)) %>%
mutate(rndDelta=round(dEV, 2)) %>%
group_by(rndDelta) %>%
summarize(ct=n(), evLoss=100 * sum(rndDelta)/sum(cardWeight)) %>%
print.data.frame()## rndDelta ct evLoss
## 1 -4.69 288 -0.0519715579
## 2 -1.06 19008 -0.7752516391
## 3 -0.08 1116 -0.0034352202
## 4 -0.07 180 -0.0004848093
## 5 -0.06 108 -0.0002493305
## 6 -0.05 1188 -0.0022855296
## 7 -0.04 10272 -0.0158094007
## 8 -0.03 36336 -0.0419429310
## 9 -0.02 161832 -0.1245359682
## 10 -0.01 50352 -0.0193739034
## 11 0.00 2318280 0.0000000000proc.time() - startTime## user system elapsed
## 3.53 0.47 4.04# Find the EV for using the JB 96 strategy on the BPD 96 game
sum(bpd96List$tempSmallMax[2,] != jb96List$tempSmallMax[2,])## [1] 3036sum((bpd96List$tempSmallMax[2,] != jb96List$tempSmallMax[2,]) * cardWeight)## [1] 65244bpd96EV_jb96Holds <- simPayTable(useEV=bpd96List$evSmallNoReplace,
useHold=jb96List$tempSmallMax[2, ],
useWeights=cardWeight
)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6771 -0.5536 -0.1835 -0.0039 0.1489 799.00001 + mean(rep(bpd96EV_jb96Holds, times=cardWeight))## [1] 0.9961002d_jb96_bpd96 <- bpd96EV_jb96Holds - bpd96List$tempSmallMax[1, ]
mean(rep(d_jb96_bpd96, times=cardWeight))## [1] -0.000316954data.frame(dEV=rep(d_jb96_bpd96, times=cardWeight)) %>%
mutate(rndDelta=round(dEV, 2)) %>%
group_by(rndDelta) %>%
summarize(ct=n(), evLoss=100 * sum(rndDelta)/sum(cardWeight))## # A tibble: 5 × 3
## rndDelta ct evLoss
## <dbl> <int> <dbl>
## 1 -0.04 108 -0.0001662203
## 2 -0.03 648 -0.0007479915
## 3 -0.02 26220 -0.0201773017
## 4 -0.01 26088 -0.0100378613
## 5 0.00 2545896 0.0000000000proc.time() - startTime## user system elapsed
## 4.17 0.53 4.74# Find variance for initial dealt cards in JB 96, JB 85, BP 85,
# DDB 96, TDB 97, TDB 96, and BPD 96
findMeanVar <- function(useList, useName, useWeight=cardWeight) {
gameMean <- mean(rep(useList$tempSmallMax[1, ], times=useWeight))
gameVar <- var(rep(useList$tempSmallMax[1, ], times=useWeight))
print(paste0("Game ", useName, ": Return: ", signif(1+gameMean, 5),
" and Variance on Deal: ", signif(gameVar, 4)
)
)
}
findMeanVar(useList=jb96List, useName="JB 96")## [1] "Game JB 96: Return: 0.99544 and Variance on Deal: 1.966"findMeanVar(useList=jb85List, useName="JB 85")## [1] "Game JB 85: Return: 0.97298 and Variance on Deal: 1.903"findMeanVar(useList=bp85List, useName="BP 85")## [1] "Game BP 85: Return: 0.99166 and Variance on Deal: 2.12"findMeanVar(useList=ddb96List, useName="DDB 96")## [1] "Game DDB 96: Return: 0.98981 and Variance on Deal: 4.809"findMeanVar(useList=tdb97List, useName="TDB 97")## [1] "Game TDB 97: Return: 0.99578 and Variance on Deal: 10.7"findMeanVar(useList=tdb96List, useName="TDB 96")## [1] "Game TDB 96: Return: 0.98154 and Variance on Deal: 10.68"findMeanVar(useList=bpd96List, useName="BPD 96")## [1] "Game BPD 96: Return: 0.99642 and Variance on Deal: 3.685"The functional approach takes ~10 seconds per game and generates the correct results.
Specific to using the JB96 strategy on the DDB 96 game, errors are generated as follows:
- AAppx (should just keep AA) - 19,008 hands, 0.18% penalty
- AAAA with 5-K or 2222/3333/4444 with 5-K (should discard 5-K) - 144 hands, 0.17% penalty
- A-Hx-T/L-L-L (should keep A) and inside-straight (go for it) - 234,852 hands, 0.13% penalty
- AAA with 55/66/77/88/99/TT/JJ/QQ/KK (should just keep AAA) - 216 hands, 0.03% penalty
- AAA with 22/33/44 (should just keep AAA) - 72 hands, 0.01% penalty
- mix of HHTLL - 12,492 hands, 0.01% penalty
- QJTT9 or QJT99 (should keep QJT9) - 696 hands, <0.01% penalty
- AKQsJs (should keep AKQJ) - 756 hands, <0.01% penalty
Specific to using the DDB96 strategy on the TDB97 and TDB96 games, errors are generated as follows:
- TDB97 - ~10% of holds should change from DDB 96, with EV declining by ~1.1% from ~99.6% to ~98.5% otherwise (roughly ~0.7% of the decline is driven by what to hold with dealt AAA/222/333/444)
- TDB96 - ~5% of holds should change from DDB 96, with EV declining by ~0.8% from ~98.2% to ~97.4% otherwise (roughly ~0.7% of the decline is driven by what to hold with dealt AAA/222/333/444)
Specific to using the DDB 96 strategy on the JB 96 games, errors are generated of ~1.0% (reducing returns from ~99.5% to ~98.5%). Almost all of the errors are related to the AAAxx, AAPPx, and AHHxx holds.
Specific to using the JB 96 strategy on the BPD 96 games, only minimal (<0.1% EV) errors are generated.
Broadly, playing strategy for the following games incurs minimal errors:
- JB 96, JB 95, BP 85, BPD 96 - use the JB 96 strategy which has very minimal errors throughout
- DDB 96 - modify the JB 96 strategy to account for value of Aces and Kickers (hold AAAA vs AAAA/5-K, hold AAA vs AAApp, hold AA vs AAppx, hold A vs AK/AQ/AJ/KQ/KJ/QJ)
- TDB 96 (and to an extent TDP 97) - use the DDB 96 strategy, adjusted to keep kickers with AAA/222/333/444 if available
Additionally, an algorithm is written to return the specific cards that are held for any given set of strategies:
findHolds <- function(idxKeep, myCards=cardSmall) {
# 1 is keep all 5
# 2-6 is keep 4 (1234, 1235, 1245, 1345, 2345)
# 7-16 is keep 3 (123, 124, 125, 134, 135, 145, 234, 235, 245, 345)
# 17-26 is keep 2 (12, 13, 14, 15, 23, 24, 25, 34, 35, 45)
# 27-31 is keep 1 (1, 2, 3, 4, 5)
# 32 is keep 0 ()
storage.mode(myCards) <- "integer"
keepCol <- matrix(data=TRUE, nrow=length(idxKeep), ncol=5)
keepCol[, 1] <- idxKeep %in% c(1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 12, 17, 18, 19, 20, 27)
keepCol[, 2] <- idxKeep %in% c(1, 2, 3, 4, 6, 7, 8, 9, 13, 14, 15, 17, 21, 22, 23, 28)
keepCol[, 3] <- idxKeep %in% c(1, 2, 3, 5, 6, 7, 10, 11, 13, 14, 16, 18, 21, 24, 25, 29)
keepCol[, 4] <- idxKeep %in% c(1, 2, 4, 5, 6, 8, 10, 12, 13, 15, 16, 19, 22, 24, 26, 30)
keepCol[, 5] <- idxKeep %in% c(1, 3, 4, 5, 6, 9, 11, 12, 14, 15, 16, 20, 23, 25, 26, 31)
myCards[!keepCol] <- NA_integer_
myCards
}
diffHolds <- function(holdA, holdB) {
holdA[is.na(holdA)] <- -1L
holdB[is.na(holdB)] <- -1L
deltaHolds <- rowSums(abs(holdA - holdB)) > 0
deltaHolds
}
jb96Holds <- findHolds(idxKeep=jb96List$tempSmallMax[2, ])
bp85Holds <- findHolds(idxKeep=bp85List$tempSmallMax[2, ])
jb85Holds <- findHolds(idxKeep=jb85List$tempSmallMax[2, ])
bpd96Holds <- findHolds(idxKeep=bpd96List$tempSmallMax[2, ])
ddb96Holds <- findHolds(idxKeep=ddb96List$tempSmallMax[2, ])
tdb96Holds <- findHolds(idxKeep=tdb96List$tempSmallMax[2, ])
# Compare JB 96 and BP 85
jb96_vs_bp85Holds <- diffHolds(jb96Holds, bp85Holds)
sum(jb96_vs_bp85Holds)## [1] 721if (sum(jb96_vs_bp85Holds) > 0) {
cbind(cardSmall[jb96_vs_bp85Holds, ],
jb96Holds[jb96_vs_bp85Holds, ],
bp85Holds[jb96_vs_bp85Holds, ]
)[sort(sample(1:sum(jb96_vs_bp85Holds), 20)), ]
}## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
## [1,] 1 5 10 13 23 1 5 10 13 NA 1 NA 10
## [2,] 1 4 23 25 28 NA NA 23 25 NA 1 NA NA
## [3,] 1 2 10 12 26 1 2 10 12 NA 1 NA 10
## [4,] 10 12 14 29 43 10 12 NA NA NA NA 12 14
## [5,] 1 3 7 23 25 NA NA NA 23 25 1 NA NA
## [6,] 11 12 14 26 31 11 12 NA NA NA 11 12 14
## [7,] 6 8 23 25 27 NA NA 23 25 NA NA NA NA
## [8,] 1 6 10 12 24 1 6 10 12 NA 1 NA 10
## [9,] 2 3 5 24 38 2 3 5 NA NA NA NA NA
## [10,] 3 10 13 15 32 NA 10 13 NA NA NA NA 13
## [11,] 3 10 13 15 21 NA 10 13 NA NA NA NA 13
## [12,] 7 9 11 15 38 7 9 11 NA NA NA NA 11
## [13,] 3 10 13 19 33 NA 10 13 NA NA NA NA 13
## [14,] 8 10 13 16 20 NA 10 13 NA NA NA NA 13
## [15,] 10 11 21 26 31 10 11 NA NA NA NA 11 NA
## [16,] 10 11 18 34 52 10 11 NA NA NA NA 11 NA
## [17,] 8 9 12 19 37 8 9 12 NA NA NA NA 12
## [18,] 10 11 19 26 35 10 11 NA NA NA NA 11 NA
## [19,] 7 8 9 24 26 7 8 9 NA NA NA NA NA
## [20,] 7 10 11 21 38 7 10 11 NA NA NA NA 11
## [,14] [,15]
## [1,] 13 NA
## [2,] 25 NA
## [3,] 12 NA
## [4,] NA NA
## [5,] NA 25
## [6,] 26 NA
## [7,] 25 27
## [8,] 12 NA
## [9,] 24 38
## [10,] NA NA
## [11,] NA NA
## [12,] NA 38
## [13,] NA NA
## [14,] NA NA
## [15,] 26 NA
## [16,] NA 52
## [17,] NA 37
## [18,] 26 NA
## [19,] 24 26
## [20,] NA 38# Compare JB 96 and JB 85
jb96_vs_jb85Holds <- diffHolds(jb96Holds, jb85Holds)
sum(jb96_vs_jb85Holds)## [1] 597if (sum(jb96_vs_jb85Holds) > 0) {
cbind(cardSmall[jb96_vs_jb85Holds, ],
jb96Holds[jb96_vs_jb85Holds, ],
jb85Holds[jb96_vs_jb85Holds, ]
)[sort(sample(1:sum(jb96_vs_jb85Holds), 20)), ]
}## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
## [1,] 2 3 4 14 32 2 3 4 NA NA NA NA NA
## [2,] 1 8 23 25 28 NA NA 23 25 NA 1 NA NA
## [3,] 11 12 14 26 28 11 12 NA NA NA 11 12 14
## [4,] 11 12 14 26 29 11 12 NA NA NA 11 12 14
## [5,] 1 5 10 12 26 1 5 10 12 NA 1 NA 10
## [6,] 11 12 14 26 34 11 12 NA NA NA 11 12 14
## [7,] 7 10 13 15 18 NA 10 13 NA NA NA NA 13
## [8,] 2 10 13 18 21 NA 10 13 NA NA NA NA 13
## [9,] 10 11 22 26 28 10 11 NA NA NA NA 11 NA
## [10,] 8 10 13 16 20 NA 10 13 NA NA NA NA 13
## [11,] 7 10 13 16 34 NA 10 13 NA NA NA NA 13
## [12,] 7 8 11 16 38 7 8 11 NA NA NA NA 11
## [13,] 10 11 16 26 34 10 11 NA NA NA NA 11 NA
## [14,] 4 5 6 24 25 4 5 6 NA NA NA NA NA
## [15,] 4 6 7 23 24 4 6 7 NA NA NA NA NA
## [16,] 6 10 13 17 20 NA 10 13 NA NA NA NA 13
## [17,] 10 11 17 26 35 10 11 NA NA NA NA 11 NA
## [18,] 8 9 12 18 24 8 9 12 NA NA NA NA 12
## [19,] 7 10 13 19 34 NA 10 13 NA NA NA NA 13
## [20,] 6 9 23 24 39 NA NA 23 24 NA NA NA NA
## [,14] [,15]
## [1,] 14 NA
## [2,] 25 NA
## [3,] 26 NA
## [4,] 26 NA
## [5,] 12 NA
## [6,] 26 NA
## [7,] NA NA
## [8,] NA NA
## [9,] 26 NA
## [10,] NA NA
## [11,] NA NA
## [12,] NA 38
## [13,] 26 NA
## [14,] 24 25
## [15,] 23 24
## [16,] NA NA
## [17,] 26 NA
## [18,] NA 24
## [19,] NA NA
## [20,] 24 39# Compare BP 85 and JB 85
bp85_vs_jb85Holds <- diffHolds(bp85Holds, jb85Holds)
sum(bp85_vs_jb85Holds)## [1] 124if (sum(bp85_vs_jb85Holds) > 0) {
cbind(cardSmall[bp85_vs_jb85Holds, ],
bp85Holds[bp85_vs_jb85Holds, ],
jb85Holds[bp85_vs_jb85Holds, ]
)[sort(sample(1:sum(bp85_vs_jb85Holds), 20)), ]
}## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
## [1,] 2 3 4 14 34 NA NA NA 14 NA 2 3 4
## [2,] 2 3 4 14 36 NA NA NA 14 NA 2 3 4
## [3,] 1 2 23 25 29 1 NA NA 25 NA NA NA 23
## [4,] 2 3 23 25 27 NA NA NA 25 27 NA NA 23
## [5,] 2 4 5 14 19 NA NA NA 14 NA 2 4 5
## [6,] 2 4 5 14 37 NA NA NA 14 37 2 4 5
## [7,] 2 4 5 14 39 NA NA NA 14 39 2 4 5
## [8,] 1 2 23 25 32 1 NA NA 25 NA NA NA 23
## [9,] 2 6 23 25 27 NA NA NA 25 27 NA NA 23
## [10,] 1 2 23 25 33 1 NA NA 25 NA NA NA 23
## [11,] 1 7 23 25 28 1 NA NA 25 NA NA NA 23
## [12,] 1 3 23 25 30 1 NA NA 25 NA NA NA 23
## [13,] 1 4 23 25 29 1 NA NA 25 NA NA NA 23
## [14,] 3 4 23 25 27 NA NA NA 25 27 NA NA 23
## [15,] 4 6 23 25 27 NA NA NA 25 27 NA NA 23
## [16,] 1 5 7 23 25 1 NA NA NA 25 NA NA NA
## [17,] 10 12 14 31 46 NA 12 14 NA NA 10 12 NA
## [18,] 6 7 9 14 36 NA NA NA 14 NA 6 7 9
## [19,] 1 7 23 25 32 1 NA NA 25 NA NA NA 23
## [20,] 6 7 23 25 27 NA NA NA 25 27 NA NA 23
## [,14] [,15]
## [1,] NA NA
## [2,] NA NA
## [3,] 25 NA
## [4,] 25 NA
## [5,] NA NA
## [6,] NA NA
## [7,] NA NA
## [8,] 25 NA
## [9,] 25 NA
## [10,] 25 NA
## [11,] 25 NA
## [12,] 25 NA
## [13,] 25 NA
## [14,] 25 NA
## [15,] 25 NA
## [16,] 23 25
## [17,] NA NA
## [18,] NA NA
## [19,] 25 NA
## [20,] 25 NA# Compare JB 96 and DDB 96
jb96_vs_ddb96Holds <- diffHolds(jb96Holds, ddb96Holds)
sum(jb96_vs_ddb96Holds)## [1] 13077if (sum(jb96_vs_ddb96Holds) > 0) {
cbind(cardSmall[jb96_vs_ddb96Holds, ],
jb96Holds[jb96_vs_ddb96Holds, ],
ddb96Holds[jb96_vs_ddb96Holds, ]
)[sort(sample(1:sum(jb96_vs_ddb96Holds), 20)), ]
}## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
## [1,] 1 12 14 17 38 1 12 14 NA 38 1 NA 14
## [2,] 1 3 9 15 25 1 NA NA NA 25 1 NA NA
## [3,] 1 5 15 20 38 1 NA NA NA 38 1 NA NA
## [4,] 5 9 12 14 28 NA NA 12 14 NA NA NA NA
## [5,] 2 9 12 14 21 NA NA 12 14 NA NA NA NA
## [6,] 4 9 13 14 16 NA NA 13 14 NA NA NA NA
## [7,] 3 6 18 25 27 NA NA NA 25 27 NA NA NA
## [8,] 1 3 10 18 25 1 NA NA NA 25 1 NA NA
## [9,] 6 7 11 14 29 NA NA 11 14 NA NA NA NA
## [10,] 1 6 9 16 25 1 NA NA NA 25 1 NA NA
## [11,] 1 5 17 35 50 1 NA NA NA 50 1 NA NA
## [12,] 1 7 17 24 36 1 NA NA 24 NA 1 NA NA
## [13,] 1 8 19 33 52 1 NA NA NA 52 1 NA NA
## [14,] 1 6 20 26 35 1 NA NA 26 NA 1 NA NA
## [15,] 8 10 20 25 27 NA NA NA 25 27 NA NA NA
## [16,] 7 10 14 34 51 NA NA 14 NA 51 NA NA 14
## [17,] 2 3 8 17 32 NA NA NA NA NA 2 3 NA
## [18,] 4 10 13 15 31 NA 10 13 NA NA 4 10 13
## [19,] 7 10 13 15 34 NA 10 13 NA NA 7 10 13
## [20,] 4 8 18 22 33 NA NA NA NA NA 4 8 18
## [,14] [,15]
## [1,] NA NA
## [2,] NA NA
## [3,] NA NA
## [4,] 14 NA
## [5,] 14 NA
## [6,] 14 NA
## [7,] NA 27
## [8,] NA NA
## [9,] 14 NA
## [10,] NA NA
## [11,] NA NA
## [12,] NA NA
## [13,] NA NA
## [14,] NA NA
## [15,] NA 27
## [16,] NA NA
## [17,] 17 32
## [18,] NA NA
## [19,] NA NA
## [20,] NA 33# Compare JB 96 and BPD 96
jb96_vs_bpd96Holds <- diffHolds(jb96Holds, bpd96Holds)
sum(jb96_vs_bpd96Holds)## [1] 3036if (sum(jb96_vs_bpd96Holds) > 0) {
cbind(cardSmall[jb96_vs_bpd96Holds, ],
jb96Holds[jb96_vs_bpd96Holds, ],
bpd96Holds[jb96_vs_bpd96Holds, ]
)[sort(sample(1:sum(jb96_vs_bpd96Holds), 20)), ]
}## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
## [1,] 2 6 10 14 37 NA NA NA 14 37 NA NA NA
## [2,] 1 5 11 23 39 1 NA 11 NA NA 1 NA 11
## [3,] 8 11 14 35 51 NA 11 NA NA 51 8 11 NA
## [4,] 3 6 18 20 28 NA NA NA NA NA 3 6 18
## [5,] 2 5 19 21 29 NA NA NA NA NA 2 5 19
## [6,] 2 5 16 22 32 NA NA NA NA NA 2 5 16
## [7,] 2 6 18 22 30 NA NA NA NA NA 2 6 18
## [8,] 8 9 15 25 37 NA NA NA 25 37 8 9 NA
## [9,] 2 9 13 23 24 NA NA NA 23 24 NA 9 13
## [10,] 3 5 17 20 35 NA NA NA NA NA 3 5 17
## [11,] 4 5 10 16 20 NA NA NA NA NA 4 5 NA
## [12,] 6 7 17 21 29 NA NA NA NA NA 6 7 17
## [13,] 3 7 10 17 19 NA NA NA NA NA 3 7 NA
## [14,] 3 6 10 20 34 NA NA NA NA NA NA 6 10
## [15,] 7 8 19 23 29 NA NA NA NA NA 7 8 19
## [16,] 6 7 16 34 49 NA NA NA NA NA 6 7 NA
## [17,] 6 10 13 16 34 NA 10 13 NA NA NA NA 13
## [18,] 4 6 20 22 36 NA NA NA NA NA NA 6 20
## [19,] 8 10 13 17 20 NA 10 13 NA NA NA NA 13
## [20,] 6 11 21 25 35 NA 11 NA 25 NA NA 11 21
## [,14] [,15]
## [1,] NA 37
## [2,] 23 39
## [3,] 35 51
## [4,] 20 NA
## [5,] NA 29
## [6,] NA 32
## [7,] NA 30
## [8,] 25 37
## [9,] 23 24
## [10,] 20 NA
## [11,] 16 20
## [12,] 21 NA
## [13,] 17 19
## [14,] 20 34
## [15,] 23 NA
## [16,] 34 49
## [17,] NA NA
## [18,] 22 36
## [19,] NA NA
## [20,] 25 35# Compare TDB 96 and DDB 96
tdb96_vs_ddb96Holds <- diffHolds(tdb96Holds, ddb96Holds)
sum(tdb96_vs_ddb96Holds)## [1] 7376if (sum(tdb96_vs_ddb96Holds) > 0) {
cbind(cardSmall[tdb96_vs_ddb96Holds, ],
tdb96Holds[tdb96_vs_ddb96Holds, ],
ddb96Holds[tdb96_vs_ddb96Holds, ]
)[sort(sample(1:sum(tdb96_vs_ddb96Holds), 20)), ]
}## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
## [1,] 4 11 17 30 41 4 NA 17 30 41 4 NA 17
## [2,] 5 6 8 21 33 5 6 8 NA 33 NA NA 8
## [3,] 7 9 21 22 32 7 9 21 NA 32 NA 9 NA
## [4,] 10 12 13 22 26 10 12 13 NA NA NA NA 13
## [5,] 3 11 20 25 27 NA NA NA NA 27 NA 11 NA
## [6,] 1 7 11 17 26 1 7 11 NA NA 1 NA 11
## [7,] 1 13 17 36 50 1 13 NA 36 50 1 13 NA
## [8,] 1 7 12 21 26 1 7 12 NA NA 1 NA 12
## [9,] 12 13 14 35 49 12 13 14 NA 49 12 13 NA
## [10,] 4 6 12 15 29 4 6 12 NA NA NA NA 12
## [11,] 2 4 7 16 35 2 4 7 NA NA NA NA NA
## [12,] 2 3 7 18 21 2 3 7 NA NA NA NA NA
## [13,] 2 4 9 18 20 2 4 9 NA NA NA NA NA
## [14,] 2 5 12 21 22 2 5 12 NA NA NA NA 12
## [15,] 3 4 10 21 35 3 4 10 NA NA NA NA NA
## [16,] 3 9 11 18 19 3 9 11 NA NA NA NA 11
## [17,] 3 11 18 25 36 NA 11 NA 25 36 NA 11 NA
## [18,] 5 9 13 17 34 5 9 13 NA NA NA NA 13
## [19,] 4 7 13 19 21 4 7 13 NA NA NA NA 13
## [20,] 7 10 18 25 37 NA 10 NA 25 37 NA NA NA
## [,14] [,15]
## [1,] 30 NA
## [2,] 21 NA
## [3,] 22 NA
## [4,] NA 26
## [5,] 25 NA
## [6,] NA NA
## [7,] NA NA
## [8,] NA NA
## [9,] NA NA
## [10,] NA NA
## [11,] NA NA
## [12,] NA NA
## [13,] NA NA
## [14,] NA NA
## [15,] NA NA
## [16,] NA NA
## [17,] 25 NA
## [18,] NA NA
## [19,] NA NA
## [20,] 25 37Next, a sampling of hands is taken assuming only the cards on the deal (draw assumed to provide exactly the EV of the deal; essentially n-play as n -> +Inf). First, a function is written:
simDrawOnly <- function(useList, useWeight=cardWeight, nCards=1000, nSims=10) {
# gameHold <- vector("list", length=nSims)
gameHold <- base::sample(rep(useList$tempSmallMax[1, ], times=useWeight),
nCards*nSims, replace=TRUE
)
gameCtr <- rep(1:nSims, each=nCards)
# for (intCtr in 1:nSims) {
# gameHold[[intCtr]] <- base::sample(rep(useList$tempSmallMax[1, ], times=useWeight),
# nCards, replace=TRUE
# )
# }
gameResults <- tapply(gameHold, gameCtr, FUN=sum)
gameMins <- tapply(gameHold, gameCtr, FUN=function(x) { min(cumsum(x)) })
print(summary(gameResults))
print(summary(gameMins))
list(totalSum=gameResults, worstSum=gameMins)
}Then, a 40,000 x 2,000 simulation is run for each of seven game types, with the results cached to improve run times:
nDeals <- 40000
jb96SimDraw <- simDrawOnly(useList=jb96List, nCards=nDeals, nSims=2000)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -832.20 -358.80 -220.80 -182.80 -62.75 1774.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -855.6000 -408.4000 -293.1000 -299.6000 -171.3000 0.6011jb85SimDraw <- simDrawOnly(useList=jb85List, nCards=nDeals, nSims=2000)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1747.0 -1250.0 -1117.0 -1081.0 -977.0 705.4
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1747.00 -1268.00 -1136.00 -1117.00 -999.50 -78.88bp85SimDraw <- simDrawOnly(useList=bp85List, nCards=nDeals, nSims=2000)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1108.0 -519.7 -365.1 -345.4 -226.0 1644.0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1137.000 -561.100 -419.900 -433.500 -297.800 -5.908bpd96SimDraw <- simDrawOnly(useList=bpd96List, nCards=nDeals, nSims=2000)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1141.00 -420.30 -191.90 -161.10 55.06 1821.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1199.0000 -525.8000 -350.7000 -370.5000 -190.3000 -0.6652ddb96SimDraw <- simDrawOnly(useList=ddb96List, nCards=nDeals, nSims=2000)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1551.0 -712.6 -433.5 -397.0 -132.1 1545.0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1553.000 -794.500 -569.300 -583.200 -353.500 -2.571tdb96SimDraw <- simDrawOnly(useList=tdb96List, nCards=nDeals, nSims=2000)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -2389.0 -1215.0 -850.3 -760.5 -381.6 2893.0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -2398.000 -1297.000 -1001.000 -986.700 -665.700 3.738The histograms and associated summary statistics are examined and compared:
fmtDeals <- prettyNum(nDeals, big.mark=",")
# JB 96 vs BP 85
hist(pmin(jb96SimDraw$totalSum/nDeals, 0.2), breaks=seq(-0.1, 0.2, by=0.005),
col=rgb(1, 0, 0, 0.4),
main=paste0("Cumulative Returns (deal-only EV) for ", fmtDeals, " Hands"),
xlab=paste0("Cumulative Return after ", fmtDeals, " Hands (capped at 20%)")
)
hist(pmin(bp85SimDraw$totalSum/nDeals, 0.2), breaks=seq(-0.1, 0.2, by=0.005),
col=rgb(0, 0, 1, 0.4), add=TRUE
)
legend("topright", pch=19, legend=c("JB 96", "BP 85", "Overlap"),
col=c(rgb(1, 0, 0, 0.4), rgb(0, 0, 1, 0.4), rgb(0.5, 0, 0.5, 0.6))
)
# JB 96 vs JB 85
hist(pmin(jb96SimDraw$totalSum/nDeals, 0.2), breaks=seq(-0.1, 0.2, by=0.005),
col=rgb(1, 0, 0, 0.4),
main=paste0("Cumulative Returns (deal-only EV) for ", fmtDeals, " Hands"),
xlab=paste0("Cumulative Return after ", fmtDeals, " Hands (capped at 20%)")
)
hist(pmin(jb85SimDraw$totalSum/nDeals, 0.2), breaks=seq(-0.1, 0.2, by=0.005),
col=rgb(0, 0, 1, 0.4), add=TRUE
)
legend("topright", pch=19, legend=c("JB 96", "JB 85", "Overlap"),
col=c(rgb(1, 0, 0, 0.4), rgb(0, 0, 1, 0.4), rgb(0.5, 0, 0.5, 0.6))
)
# JB 96 vs BPD 96
hist(pmin(jb96SimDraw$totalSum/nDeals, 0.2), breaks=seq(-0.1, 0.2, by=0.005),
col=rgb(1, 0, 0, 0.4),
main=paste0("Cumulative Returns (deal-only EV) for ", fmtDeals, " Hands"),
xlab=paste0("Cumulative Return after ", fmtDeals, " Hands (capped at 20%)")
)
hist(pmin(bpd96SimDraw$totalSum/nDeals, 0.2), breaks=seq(-0.1, 0.2, by=0.005),
col=rgb(0, 0, 1, 0.4), add=TRUE
)
legend("topright", pch=19, legend=c("JB 96", "BPD 96", "Overlap"),
col=c(rgb(1, 0, 0, 0.4), rgb(0, 0, 1, 0.4), rgb(0.5, 0, 0.5, 0.6))
)
# JB 96 vs DDB 96
hist(pmin(jb96SimDraw$totalSum/nDeals, 0.2), breaks=seq(-0.1, 0.2, by=0.005),
col=rgb(1, 0, 0, 0.4),
main=paste0("Cumulative Returns (deal-only EV) for ", fmtDeals, " Hands"),
xlab=paste0("Cumulative Return after ", fmtDeals, " Hands (capped at 20%)")
)
hist(pmin(ddb96SimDraw$totalSum/nDeals, 0.2), breaks=seq(-0.1, 0.2, by=0.005),
col=rgb(0, 0, 1, 0.4), add=TRUE
)
legend("topright", pch=19, legend=c("JB 96", "DDB 96", "Overlap"),
col=c(rgb(1, 0, 0, 0.4), rgb(0, 0, 1, 0.4), rgb(0.5, 0, 0.5, 0.6))
)
# DDB 96 vs TDB 96
hist(pmin(ddb96SimDraw$totalSum/nDeals, 0.2), breaks=seq(-0.1, 0.2, by=0.005),
col=rgb(1, 0, 0, 0.4),
main=paste0("Cumulative Returns (deal-only EV) for ", fmtDeals, " Hands"),
xlab=paste0("Cumulative Return after ", fmtDeals, " Hands (capped at 20%)")
)
hist(pmin(tdb96SimDraw$totalSum/nDeals, 0.2), breaks=seq(-0.1, 0.2, by=0.005),
col=rgb(0, 0, 1, 0.4), add=TRUE
)
legend("topright", pch=19, legend=c("DDB 96", "TDB 96", "Overlap"),
col=c(rgb(1, 0, 0, 0.4), rgb(0, 0, 1, 0.4), rgb(0.5, 0, 0.5, 0.6))
)
# Comparisons of percentiles
keyQuant <- c(0.01, 0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95, 0.99)
jb96Quant <- quantile(jb96SimDraw$totalSum/nDeals, keyQuant)
jb85Quant <- quantile(jb85SimDraw$totalSum/nDeals, keyQuant)
bp85Quant <- quantile(bp85SimDraw$totalSum/nDeals, keyQuant)
bpd96Quant <- quantile(bpd96SimDraw$totalSum/nDeals, keyQuant)
ddb96Quant <- quantile(ddb96SimDraw$totalSum/nDeals, keyQuant)
tdb96Quant <- quantile(tdb96SimDraw$totalSum/nDeals, keyQuant)
allQuant <- cbind(jb85Quant, jb96Quant, bp85Quant, bpd96Quant, ddb96Quant, tdb96Quant)
xBounds <- c(floor(50*min(allQuant))/50, ceiling(50*max(allQuant))/50)
# Plot the 1%
plot(y=1:ncol(allQuant), x=allQuant[1, ], type="l", lty=2, col="red", xlim=xBounds,
ylab="Game Type", yaxt="n", main="Percentiles by Game",
xlab=paste0("EV of Deal-Only at ", fmtDeals, " Hands")
)
axis(2, at=6:1, labels=c("TDB 96", "DDB 96", "BPD 96", "BP 85", "JB 96","JB 85"), cex.axis=0.8)
points(y=1:ncol(allQuant), x=allQuant[1, ], pch=19, cex=2, col="red")
# Plot the 5%
lines(y=1:ncol(allQuant), x=allQuant[2, ], lty=2, col="orange")
points(y=1:ncol(allQuant), x=allQuant[2, ], lty=2, col="orange", pch=19, cex=2)
# Plot the 10%
lines(y=1:ncol(allQuant), x=allQuant[3, ], lty=2, col="purple")
points(y=1:ncol(allQuant), x=allQuant[3, ], lty=2, col="purple", pch=19, cex=2)
# Plot the 50%
lines(y=1:ncol(allQuant), x=allQuant[5, ], lty=2, col="black")
points(y=1:ncol(allQuant), x=allQuant[5, ], lty=2, col="black", pch=19, cex=2)
# Plot the 75%
lines(y=1:ncol(allQuant), x=allQuant[6, ], lty=2, col="dark blue")
points(y=1:ncol(allQuant), x=allQuant[6, ], lty=2, col="dark blue", pch=19, cex=2)
# Plot the 95%
lines(y=1:ncol(allQuant), x=allQuant[8, ], lty=2, col="dark green")
points(y=1:ncol(allQuant), x=allQuant[8, ], lty=2, col="dark green", pch=19, cex=2)
legend("bottomright", legend=c("1%", "5%", "10%", "50%", "75%", "95%"),
col=c("red", "orange", "purple", "black", "dark blue", "dark green"),
lty=2, pch=19
)
# Show ratios
round(allQuant[1:5, ] / allQuant[1:5, 2], 2)## jb85Quant jb96Quant bp85Quant bpd96Quant ddb96Quant tdb96Quant
## 1% 2.26 1 1.27 1.35 1.82 2.82
## 5% 2.62 1 1.33 1.29 1.91 3.09
## 10% 2.83 1 1.37 1.25 1.89 3.13
## 25% 3.48 1 1.45 1.17 1.99 3.38
## 50% 5.06 1 1.65 0.87 1.96 3.85Next, a single game type is simulated through various numbers of hands, with percentiles assessed. For starters, a function is built:
simPercentile <- function(keyList, useName,
runSims=2000,
useQuant=c(0.01, 0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95, 0.99),
yVal=c(500, 1000, 2000, 4000, 8000, 16000, 25000, 40000),
ptCol=c("red", "pink", "orange", "purple", "black",
"blue", "light green", "dark green", "grey"
)
) {
keySim <- vector("list", length(yVal))
keyQuants <- vector("list", length(yVal))
for (intCtr in seq_along(yVal)) {
keySim[[intCtr]] <- simDrawOnly(useList=keyList, nCards=yVal[intCtr], nSims=runSims)
keyQuants[[intCtr]] <- quantile(keySim[[intCtr]]$totalSum/yVal[intCtr], useQuant)
}
xVal <- sapply(keyQuants, FUN=function(x) { x })
plot(x=as.vector(xVal), y=log10(rep(yVal, each=length(useQuant))),
col=rep(ptCol, times=length(useQuant)), ylab="Log 10 (# Hands Dealt)",
xlab="EV of Deal-Only", main=paste0(useName, ": EV of Deal-Only Components"),
pch=19, ylim=c(log10(0.5 * min(yVal)), log10(2 * max(yVal)))
)
legend("top", col=ptCol, pch=19, ncol=length(useQuant),
legend=paste0(100*useQuant, "%")
)
list(keySim=keySim, keyQuants=keyQuants)
}Next, the JB 96 game is simulated, with results cached for later usage:
set.seed(1611260741)
jb96Sim <- simPercentile(keyList=jb96List, useName="JB 96")## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -65.850 -18.570 -3.225 -1.697 11.220 820.800
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -69.280 -25.800 -15.430 -17.520 -7.689 9.464
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -105.600 -28.290 -7.074 -4.168 14.110 839.000
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -109.500 -38.410 -23.690 -26.470 -11.800 4.335
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -165.800 -40.720 -12.560 -8.688 19.120 872.100
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -166.400 -56.020 -36.770 -40.090 -18.260 2.807
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -214.90 -67.36 -27.25 -21.09 19.64 890.20
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -217.600 -90.640 -57.440 -62.550 -28.250 3.302
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -329.00 -107.80 -50.04 -39.02 13.17 881.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -336.200 -136.200 -88.690 -97.530 -51.370 2.115
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -445.600 -175.400 -95.370 -80.520 -7.372 1242.000
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -463.4000 -213.8000 -145.8000 -155.2000 -83.5100 -0.5029
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -625.00 -246.80 -141.20 -112.60 -24.85 1607.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -625.800 -289.400 -198.000 -210.200 -116.200 -1.782
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -803.20 -343.50 -213.30 -183.70 -71.69 1294.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -846.1000 -403.0000 -287.2000 -296.4000 -180.9000 0.8879
Then, the BP 85 game is simulated, with results cached for later usage:
set.seed(2016112607)
bp85Sim <- simPercentile(keyList=bp85List, useName="BP 85")## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -70.880 -21.150 -6.846 -5.024 9.218 108.700
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -70.880 -28.290 -17.310 -19.390 -8.942 25.640
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -101.40 -31.23 -11.52 -8.35 10.21 815.80
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -104.500 -42.040 -26.740 -29.310 -14.620 7.813
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -165.600 -51.460 -23.050 -17.850 9.316 823.700
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -167.500 -66.440 -42.460 -46.340 -23.480 3.347
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -253.500 -85.230 -37.630 -32.160 7.131 893.400
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -257.400 -102.500 -66.320 -72.690 -37.150 3.241
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -356.90 -141.00 -79.47 -68.55 -13.03 846.80
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -381.20 -167.70 -114.70 -121.00 -67.79 18.15
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -536.10 -238.00 -148.60 -125.70 -51.19 1578.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -591.9000 -269.8000 -193.0000 -198.8000 -116.5000 -0.0156
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -796.6 -346.6 -230.2 -198.1 -104.4 1540.0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -828.9000 -387.0000 -278.8000 -286.6000 -178.3000 -0.2586
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -990.0 -514.1 -368.7 -334.7 -207.3 1322.0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1017.000 -560.700 -430.000 -429.300 -292.300 -5.151
Then, the DDB 96 game is simulated, with results cached for later usage:
set.seed(1126201607)
ddb96Sim <- simPercentile(keyList=ddb96List, useName="DDB 96")## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -92.630 -30.700 -12.020 -3.662 10.510 783.200
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -92.63 -38.97 -25.24 -26.98 -12.86 10.31
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -131.800 -48.640 -20.680 -6.814 13.940 841.800
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -137.600 -58.780 -38.470 -41.850 -20.670 4.366
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -216.30 -77.12 -35.12 -18.04 15.47 1209.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -218.5000 -94.1900 -63.7000 -67.3900 -35.7600 0.8994
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -313.60 -130.50 -67.31 -45.17 16.77 956.20
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -316.00 -155.40 -103.00 -108.90 -56.88 12.83
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -480.900 -211.500 -113.300 -81.930 5.208 1139.000
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -482.20 -249.90 -170.60 -177.80 -97.98 17.75
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -804.10 -353.40 -200.60 -163.60 -25.92 1538.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -826.3000 -407.2000 -285.8000 -293.8000 -168.4000 0.2324
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1179.00 -485.40 -302.40 -254.90 -73.42 1360.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1213.0000 -555.5000 -402.5000 -406.1000 -248.8000 -0.1293
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1664.0 -710.4 -448.7 -409.6 -153.6 1997.0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1666.0000 -794.0000 -569.7000 -583.8000 -356.7000 -0.8331
Then, the BPD 96 game is simulated, with results cached for later usage:
set.seed(1127201606)
bpd96Sim <- simPercentile(keyList=bpd96List, useName="BPD 96")## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -87.53 -28.70 -9.91 -3.54 11.28 816.70
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -88.060 -35.970 -22.890 -25.060 -11.520 4.893
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -130.90 -40.44 -12.67 -2.53 25.18 798.60
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -131.20 -53.36 -34.42 -37.10 -16.51 54.48
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -217.400 -61.410 -17.430 -7.049 36.710 887.200
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -219.000 -81.410 -50.090 -56.000 -26.060 3.679
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -300.60 -93.09 -27.62 -11.56 54.59 938.40
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -300.6000 -127.5000 -77.3600 -87.6000 -39.8800 0.5293
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -485.30 -133.20 -35.22 -25.74 64.17 1070.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -491.000 -183.400 -116.600 -128.300 -60.060 5.643
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -707.20 -211.20 -81.02 -54.85 63.84 1366.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -712.7000 -279.0000 -181.5000 -197.1000 -96.8400 0.2128
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -911.90 -275.50 -92.70 -79.82 77.52 1947.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -914.100 -375.700 -231.100 -259.100 -121.200 2.602
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1192.00 -415.20 -193.50 -152.00 76.34 1745.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1221.0000 -523.9000 -339.9000 -362.5000 -170.5000 -0.0564
Then, the TDB 96 game is simulated, with results cached for later usage:
set.seed(16112706)
tdb96Sim <- simPercentile(keyList=tdb96List, useName="TDB 96")## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -102.900 -41.560 -20.650 -8.395 1.527 826.400
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -104.30 -48.37 -33.51 -34.81 -18.73 13.45
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -162.000 -69.090 -39.570 -16.890 -2.079 910.900
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -162.000 -79.360 -55.380 -56.340 -30.320 4.836
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -247.20 -118.70 -69.58 -36.35 -9.74 1070.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -247.700 -134.700 -94.430 -97.030 -57.320 2.565
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -486.60 -203.40 -128.50 -74.82 -15.42 1423.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -494.700 -221.800 -165.100 -164.700 -103.600 3.456
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -689.200 -343.900 -210.100 -140.900 -9.978 1155.000
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -764.0000 -377.2000 -278.0000 -274.3000 -162.0000 -0.3811
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1161.00 -590.70 -388.60 -300.20 -80.31 2587.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1163.000 -643.800 -481.800 -477.500 -301.700 -0.568
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1548.0 -843.7 -530.5 -443.0 -119.9 2450.0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1591.0000 -910.0000 -670.0000 -661.7000 -406.8000 0.4446
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -2534.0 -1217.0 -838.8 -750.5 -371.7 2233.0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -2541.0000 -1313.0000 -985.1000 -981.4000 -652.5000 -0.2323
There are some interesting disconnects in the 99% EV of deal-only components, driven by the small possibilities of a nice pat hand. For example:
library(dplyr)
data.frame(rndScore=round(rep(jb96List$tempSmallMax[1, ], times=cardWeight), 0)) %>%
group_by(rndScore) %>%
summarize(ct=n(), per=round(choose(52, 5)/ct, 1)) %>%
print.data.frame()## rndScore ct per
## 1 -1 865512 3.0
## 2 0 1189032 2.2
## 3 1 344328 7.5
## 4 2 123696 21.0
## 5 3 66096 39.3
## 6 5 4952 524.8
## 7 8 3744 694.2
## 8 17 608 4274.6
## 9 18 144 18048.3
## 10 19 184 14124.8
## 11 24 624 4165.0
## 12 49 36 72193.3
## 13 799 4 649740.0data.frame(rndScore=round(rep(bp85List$tempSmallMax[1, ], times=cardWeight), 0)) %>%
group_by(rndScore) %>%
summarize(ct=n(), per=round(choose(52, 5)/ct, 1)) %>%
print.data.frame()## rndScore ct per
## 1 -1 899100 2.9
## 2 0 1158420 2.2
## 3 1 341496 7.6
## 4 2 124500 20.9
## 5 3 48252 53.9
## 6 4 17624 147.5
## 7 6 4224 615.3
## 8 7 3744 694.2
## 9 17 752 3456.1
## 10 18 52 49980.0
## 11 19 132 19689.1
## 12 24 432 6016.1
## 13 39 144 18048.3
## 14 49 36 72193.3
## 15 79 48 54145.0
## 16 799 4 649740.0data.frame(rndScore=round(rep(ddb96List$tempSmallMax[1, ], times=cardWeight), 0)) %>%
group_by(rndScore) %>%
summarize(ct=n(), per=round(choose(52, 5)/ct, 1)) %>%
print.data.frame()## rndScore ct per
## 1 -1 924432 2.8
## 2 0 1384716 1.9
## 3 1 213276 12.2
## 4 2 144 18048.3
## 5 3 11184 232.4
## 6 4 38016 68.4
## 7 5 4952 524.8
## 8 6 5760 451.2
## 9 7 6912 376.0
## 10 8 3456 752.0
## 11 11 1992 1304.7
## 12 12 2520 1031.3
## 13 17 608 4274.6
## 14 18 144 18048.3
## 15 19 184 14124.8
## 16 49 468 5553.3
## 17 99 108 24064.4
## 18 159 36 72193.3
## 19 220 36 72193.3
## 20 399 12 216580.0
## 21 799 4 649740.0data.frame(rndScore=round(rep(bpd96List$tempSmallMax[1, ], times=cardWeight), 0)) %>%
group_by(rndScore) %>%
summarize(ct=n(), per=round(choose(52, 5)/ct, 1)) %>%
print.data.frame()## rndScore ct per
## 1 -1 924432 2.8
## 2 0 1131636 2.3
## 3 1 466356 5.6
## 4 2 144 18048.3
## 5 3 11184 232.4
## 6 5 4952 524.8
## 7 6 54912 47.3
## 8 8 3744 694.2
## 9 17 608 4274.6
## 10 18 144 18048.3
## 11 19 184 14124.8
## 12 49 36 72193.3
## 13 79 624 4165.0
## 14 799 4 649740.0data.frame(rndScore=round(rep(tdb96List$tempSmallMax[1, ], times=cardWeight), 0)) %>%
group_by(rndScore) %>%
summarize(ct=n(), per=round(choose(52, 5)/ct, 1)) %>%
print.data.frame()## rndScore ct per
## 1 -1 930768 2.8
## 2 0 1379832 1.9
## 3 1 211824 12.3
## 4 2 144 18048.3
## 5 3 49200 52.8
## 6 5 4952 524.8
## 7 8 10152 256.0
## 8 10 5976 434.9
## 9 15 2520 1031.3
## 10 17 608 4274.6
## 11 18 2136 1216.7
## 12 19 184 14124.8
## 13 49 468 5553.3
## 14 161 108 24064.4
## 15 322 36 72193.3
## 16 399 36 72193.3
## 17 799 16 162435.0With simulations of size X, the “1% cut-off” on average includes dealt hands occuring every 100*X times. For JB 96, dealt-hands with EV of 799 could be expected in the “1% cut-off” for simulations of size 6500+. So, at simulation size 8,000, there is an expected “bump” as this component is worth ~10% (799/8000). The “best 1%” line can be expected to jump to median+10%, since a sequence that has a dealt 799 but otherwise runs at median should now find its way near the lower portion of the top 1% (the 1% cut-off).
This effect is less evident for BP 85 and (especially) DDB 96 since with additional high-dealt-EV components, the impact of the dealt-royal is less impactful. For example, in DDB 96, the dealt Aces Kicker is worth half as much as the dealt Royal but occurs three times as often. So, merely obtaining a dealt Royal is much less likely to convert an otherwise mundane sequence to being in the “top 1%”.
This effect is more or less non-existent for BPD 96 (all quads +79) and TDB 96 (premium quads +399/+799) since there are a series of higher-frequency hands with good dealt-EV rather than an occasional hand with good dealt-EV. So, the top 1% will almost always include some good dealt hands for BPD 96 and TDB 96 even if the sample size is too small for a dealt RF.
Variance on the Draw
Much of the variance of the game occurs during the draw, as a particular hold may allow for anything from a Royal Flush through nothing, frequently with a few back-door good pays (e.g., getting the 3 cards needed to finish a Flush or Straight), many pushes (improving to a high pair), and a great many losses. The EV on the deal averages across all of these, masking a huge portion of the game’s variance. This is particularly salient when considering the impact of N-play (one dealt hand, one hold applied across hands, N independent draws without replacement scored).
For starters, calculating variance on the draw requires keeping all of the possible outcomes. The previous function (as well as its calls to functions) that used EVs is adapted to output a matrix of possible outcomes:
findFreq_YesRedraw <- function(useIdx, mtxIndices, aTypes) {
# Assuming re-draw of thrown cards
tmpScores <- data.frame(idx=as.vector(mtxIndices[, useIdx]),
val=rep(as.integer(aTypes), times=length(useIdx))
)
# Convert them to the relevant tbl_df (chkTidy will have idx and '0' through '25' as the columns)
chkTidy <- tmpScores %>%
group_by(idx, val) %>%
summarize(ct=n()) %>%
spread(val, ct, fill=0)
# Double check that the proper number of columns exist
if (length(names(chkTidy)) != 27 |
names(chkTidy)[1] != "idx" |
!isTRUE(all.equal(as.integer(names(chkTidy)[-1]), 0:25))
) {
print(names(chkTidy))
stop("The tidy process needs to produce a tbl_df with names 'idx' and then '0' through '25'")
}
# Return the thing as a matrix
as.matrix(chkTidy)
}
calcFreq_YesRedraw <- function(mtxIndices, aTypes) {
tmpEVkeep5 <- findFreq_YesRedraw(useIdx=1, mtxIndices=mtxIndices, aTypes=aTypes)
tmpEVkeep4 <- findFreq_YesRedraw(useIdx=2:6, mtxIndices=mtxIndices, aTypes=aTypes)
tmpEVkeep3 <- findFreq_YesRedraw(useIdx=7:16, mtxIndices=mtxIndices, aTypes=aTypes)
tmpEVkeep2 <- findFreq_YesRedraw(useIdx=17:26, mtxIndices=mtxIndices, aTypes=aTypes)
tmpEVkeep1 <- findFreq_YesRedraw(useIdx=27:31, mtxIndices=mtxIndices, aTypes=aTypes)
tmpEVkeep0 <- findFreq_YesRedraw(useIdx=32, mtxIndices=mtxIndices, aTypes=aTypes)
print(dim(tmpEVkeep5))
print(dim(tmpEVkeep4))
print(dim(tmpEVkeep3))
print(dim(tmpEVkeep2))
print(dim(tmpEVkeep1))
print(dim(tmpEVkeep0))
print(tmpEVkeep0)
print(sum(tmpEVkeep5[, 1] != 1:choose(52,5)))
print(sum(tmpEVkeep4[, 1] != 1:choose(52,4)))
print(sum(tmpEVkeep3[, 1] != 1:choose(52,3)))
print(sum(tmpEVkeep2[, 1] != 1:choose(52,2)))
print(sum(tmpEVkeep1[, 1] != 1:choose(52,1)))
print(sum(tmpEVkeep0[, 1] != 1:choose(52,0)))
list(tmpEVkeep5=tmpEVkeep5, tmpEVkeep4=tmpEVkeep4,
tmpEVkeep3=tmpEVkeep3, tmpEVkeep2=tmpEVkeep2,
tmpEVkeep1=tmpEVkeep1, tmpEVkeep0=tmpEVkeep0
)
}
drawNoReplace <- function(cardIndex, cardHolds, keyList, mtxIndices) {
# cardHolds will come in small [by cardIndex] and should be used for filtering
drawSmallNoReplace <- matrix(data=0L, nrow=length(cardIndex), ncol=ncol(keyList$tmpEVkeep5))
tmpDrawkeep5 <- keyList$tmpEVkeep5
tmpDrawkeep4 <- keyList$tmpEVkeep4
tmpDrawkeep3 <- keyList$tmpEVkeep3
tmpDrawkeep2 <- keyList$tmpEVkeep2
tmpDrawkeep1 <- keyList$tmpEVkeep1
tmpDrawkeep0 <- keyList$tmpEVkeep0
# Manage the keep5 subset
drawSmallNoReplace[cardHolds == 1, ] <- tmpDrawkeep5[cardIndex, ][cardHolds == 1, ]
# Manage the keep4 subset
# Keep 4 (intCtr: 2 is 1234, 3 is 1235, 4 is 1245, 5 is 1345, 6 is 2345)
for (intCtr in 2:6) {
drawSmallNoReplace[cardHolds == intCtr, -1] <-
tmpDrawkeep4[mtxIndices[cardIndex, intCtr], -1][cardHolds == intCtr, ] -
tmpDrawkeep5[cardIndex, ][cardHolds == intCtr, -1]
}
# Manage the keep3 subset
# Keep 3 (intCtr: 7 is 123, 8 is 124, 9 is 125, 10 is 134, 11 is 135)
# Keep 3 (intCtr: 12 is 145, 13 is 234, 14 is 235, 15 is 245, 16 is 345)
# Take the results of the 3 cards assuming stand-alone
# Subtract the results for each of the 4 cards (3 + 1 discard) assuming stand-alone
# Add back the results of the 5 cards assuming stand-alone
mapKeep3 <- data.frame(idx=7:16,
keep1=c(2, 2, 3, 2, 3, 4, 2, 3, 4, 5),
keep2=c(3, 4, 4, 5, 5, 5, 6, 6, 6, 6)
)
for (intCtr in 7:16) {
c1 <- mapKeep3$keep1[mapKeep3$idx == intCtr]
c2 <- mapKeep3$keep2[mapKeep3$idx == intCtr]
drawSmallNoReplace[cardHolds == intCtr, -1] <-
tmpDrawkeep3[mtxIndices[cardIndex, intCtr], -1][cardHolds == intCtr, ] -
tmpDrawkeep4[mtxIndices[cardIndex, c1], -1][cardHolds == intCtr, ] -
tmpDrawkeep4[mtxIndices[cardIndex, c2], -1][cardHolds == intCtr, ] +
tmpDrawkeep5[cardIndex, ][cardHolds == intCtr, -1]
}
# Manage the keep2 subset
# Keep 2 (intCtr: 17 is 12, 18 is 13, 19 is 14, 20 is 15, 21 is 23)
# Keep 2 (intCtr: 22 is 24, 23 is 25, 24 is 34, 25 is 35, 26 is 45)
# Take the results of the 2 cards assuming stand-alone
# Subtract the results of each of the 3 cards (2 + 1 discard) assuming stand-alone
# Add back the results of each of the 4 cards (2 + 2 discard) assuming stand-alone
# Subtract the results of the 5 cards assuming stand-alone
mapKeep2 <- data.frame(idx=17:26,
keep3_1=c(7, 7, 8, 9, 7, 8, 9, 10, 11, 12),
keep3_2=c(8, 10, 10, 11, 13, 13, 14, 13, 14, 15),
keep3_3=c(9, 11, 12, 12, 14, 15, 15, 16, 16, 16),
keep4_1=c(2, 2, 2, 3, 2, 2, 3, 2, 3, 4),
keep4_2=c(3, 3, 4, 4, 3, 4, 4, 5, 5, 5),
keep4_3=c(4, 5, 5, 5, 6, 6, 6, 6, 6, 6)
)
for (intCtr in 17:26) {
c31 <- mapKeep2$keep3_1[mapKeep2$idx == intCtr]
c32 <- mapKeep2$keep3_2[mapKeep2$idx == intCtr]
c33 <- mapKeep2$keep3_3[mapKeep2$idx == intCtr]
c41 <- mapKeep2$keep4_1[mapKeep2$idx == intCtr]
c42 <- mapKeep2$keep4_2[mapKeep2$idx == intCtr]
c43 <- mapKeep2$keep4_3[mapKeep2$idx == intCtr]
drawSmallNoReplace[cardHolds == intCtr, -1] <-
tmpDrawkeep2[mtxIndices[cardIndex, intCtr], -1][cardHolds == intCtr, ] -
tmpDrawkeep3[mtxIndices[cardIndex, c31], -1][cardHolds == intCtr, ] -
tmpDrawkeep3[mtxIndices[cardIndex, c32], -1][cardHolds == intCtr, ] -
tmpDrawkeep3[mtxIndices[cardIndex, c33], -1][cardHolds == intCtr, ] +
tmpDrawkeep4[mtxIndices[cardIndex, c41], -1][cardHolds == intCtr, ] +
tmpDrawkeep4[mtxIndices[cardIndex, c42], -1][cardHolds == intCtr, ] +
tmpDrawkeep4[mtxIndices[cardIndex, c43], -1][cardHolds == intCtr, ] -
tmpDrawkeep5[cardIndex, ][cardHolds == intCtr, -1]
}
# Manage the keep1 subset
# Keep 1 (intCtr: 27 is 1, 28 is 2, 29 is 3, 30 is 4, 31 is 5)
# Take the results of the 1 card assuming stand-alone
# Subtract the results of the 2 cards (1 + 1 discard) assuming stand-alone
# Add back the results of each of the 3 cards (1 + 2 discard) assuming stand-alone
# Subtract the results of each of the 4 cards (1 + 3 discard) assuming stand-alone
# Add back the results of the 5 cards assuming stand-alone
mapKeep1 <- data.frame(idx=27:31,
keep2_1=c(17, 17, 18, 19, 20),
keep2_2=c(18, 21, 21, 22, 23),
keep2_3=c(19, 22, 24, 24, 25),
keep2_4=c(20, 23, 25, 26, 26),
keep3_1=c(7, 7, 7, 8, 9),
keep3_2=c(8, 8, 10, 10, 11),
keep3_3=c(9, 9, 11, 12, 12),
keep3_4=c(10, 13, 13, 13, 14),
keep3_5=c(11, 14, 14, 15, 15),
keep3_6=c(12, 15, 16, 16, 16),
keep4_1=c(2, 2, 2, 2, 3),
keep4_2=c(3, 3, 3, 4, 4),
keep4_3=c(4, 4, 5, 5, 5),
keep4_4=c(5, 6, 6, 6, 6)
)
for (intCtr in 27:31) {
c21 <- mapKeep1$keep2_1[mapKeep1$idx == intCtr]
c22 <- mapKeep1$keep2_2[mapKeep1$idx == intCtr]
c23 <- mapKeep1$keep2_3[mapKeep1$idx == intCtr]
c24 <- mapKeep1$keep2_4[mapKeep1$idx == intCtr]
c31 <- mapKeep1$keep3_1[mapKeep1$idx == intCtr]
c32 <- mapKeep1$keep3_2[mapKeep1$idx == intCtr]
c33 <- mapKeep1$keep3_3[mapKeep1$idx == intCtr]
c34 <- mapKeep1$keep3_4[mapKeep1$idx == intCtr]
c35 <- mapKeep1$keep3_5[mapKeep1$idx == intCtr]
c36 <- mapKeep1$keep3_6[mapKeep1$idx == intCtr]
c41 <- mapKeep1$keep4_1[mapKeep1$idx == intCtr]
c42 <- mapKeep1$keep4_2[mapKeep1$idx == intCtr]
c43 <- mapKeep1$keep4_3[mapKeep1$idx == intCtr]
c44 <- mapKeep1$keep4_4[mapKeep1$idx == intCtr]
drawSmallNoReplace[cardHolds == intCtr, -1] <-
tmpDrawkeep1[mtxIndices[cardIndex, intCtr], -1][cardHolds == intCtr, ] -
tmpDrawkeep2[mtxIndices[cardIndex, c21], -1][cardHolds == intCtr, ] -
tmpDrawkeep2[mtxIndices[cardIndex, c22], -1][cardHolds == intCtr, ] -
tmpDrawkeep2[mtxIndices[cardIndex, c23], -1][cardHolds == intCtr, ] -
tmpDrawkeep2[mtxIndices[cardIndex, c24], -1][cardHolds == intCtr, ] +
tmpDrawkeep3[mtxIndices[cardIndex, c31], -1][cardHolds == intCtr, ] +
tmpDrawkeep3[mtxIndices[cardIndex, c32], -1][cardHolds == intCtr, ] +
tmpDrawkeep3[mtxIndices[cardIndex, c33], -1][cardHolds == intCtr, ] +
tmpDrawkeep3[mtxIndices[cardIndex, c34], -1][cardHolds == intCtr, ] +
tmpDrawkeep3[mtxIndices[cardIndex, c35], -1][cardHolds == intCtr, ] +
tmpDrawkeep3[mtxIndices[cardIndex, c36], -1][cardHolds == intCtr, ] -
tmpDrawkeep4[mtxIndices[cardIndex, c41], -1][cardHolds == intCtr, ] -
tmpDrawkeep4[mtxIndices[cardIndex, c42], -1][cardHolds == intCtr, ] -
tmpDrawkeep4[mtxIndices[cardIndex, c43], -1][cardHolds == intCtr, ] -
tmpDrawkeep4[mtxIndices[cardIndex, c44], -1][cardHolds == intCtr, ] +
tmpDrawkeep5[cardIndex, ][cardHolds == intCtr, -1]
}
# Manage the keep0 subset
# Keep 0 (column 32)
# Take the results of the 0 card assuming stand-alone
# Subtract the results of each 1 card (0 + 1 discard) assuming stand-alone
# Add back the results of each of the 2 cards (0 + 2 discard) assuming stand-alone
# Subtract the results of each of the 3 cards (0 + 3 discard) assuming stand-alone
# Add back the results of each of the 4 cards (0 + 4 discard) assuming stand-alone
# Subtract the results of the 5 cards assuming stand-alone
drawSmallNoReplace[cardHolds == 32, -1] <-
matrix(data=rep(tmpDrawkeep0[, -1], times=sum(cardHolds==32)),
nrow=sum(cardHolds==32), byrow=TRUE
) -
tmpDrawkeep1[mtxIndices[cardIndex, 31], -1][cardHolds == 32, ] -
tmpDrawkeep1[mtxIndices[cardIndex, 30], -1][cardHolds == 32, ] -
tmpDrawkeep1[mtxIndices[cardIndex, 29], -1][cardHolds == 32, ] -
tmpDrawkeep1[mtxIndices[cardIndex, 28], -1][cardHolds == 32, ] -
tmpDrawkeep1[mtxIndices[cardIndex, 27], -1][cardHolds == 32, ] +
tmpDrawkeep2[mtxIndices[cardIndex, 26], -1][cardHolds == 32, ] +
tmpDrawkeep2[mtxIndices[cardIndex, 25], -1][cardHolds == 32, ] +
tmpDrawkeep2[mtxIndices[cardIndex, 24], -1][cardHolds == 32, ] +
tmpDrawkeep2[mtxIndices[cardIndex, 23], -1][cardHolds == 32, ] +
tmpDrawkeep2[mtxIndices[cardIndex, 22], -1][cardHolds == 32, ] +
tmpDrawkeep2[mtxIndices[cardIndex, 21], -1][cardHolds == 32, ] +
tmpDrawkeep2[mtxIndices[cardIndex, 20], -1][cardHolds == 32, ] +
tmpDrawkeep2[mtxIndices[cardIndex, 19], -1][cardHolds == 32, ] +
tmpDrawkeep2[mtxIndices[cardIndex, 18], -1][cardHolds == 32, ] +
tmpDrawkeep2[mtxIndices[cardIndex, 17], -1][cardHolds == 32, ] -
tmpDrawkeep3[mtxIndices[cardIndex, 16], -1][cardHolds == 32, ] -
tmpDrawkeep3[mtxIndices[cardIndex, 15], -1][cardHolds == 32, ] -
tmpDrawkeep3[mtxIndices[cardIndex, 14], -1][cardHolds == 32, ] -
tmpDrawkeep3[mtxIndices[cardIndex, 13], -1][cardHolds == 32, ] -
tmpDrawkeep3[mtxIndices[cardIndex, 12], -1][cardHolds == 32, ] -
tmpDrawkeep3[mtxIndices[cardIndex, 11], -1][cardHolds == 32, ] -
tmpDrawkeep3[mtxIndices[cardIndex, 10], -1][cardHolds == 32, ] -
tmpDrawkeep3[mtxIndices[cardIndex, 9], -1][cardHolds == 32, ] -
tmpDrawkeep3[mtxIndices[cardIndex, 8], -1][cardHolds == 32, ] -
tmpDrawkeep3[mtxIndices[cardIndex, 7], -1][cardHolds == 32, ] +
tmpDrawkeep4[mtxIndices[cardIndex, 6], -1][cardHolds == 32, ] +
tmpDrawkeep4[mtxIndices[cardIndex, 5], -1][cardHolds == 32, ] +
tmpDrawkeep4[mtxIndices[cardIndex, 4], -1][cardHolds == 32, ] +
tmpDrawkeep4[mtxIndices[cardIndex, 3], -1][cardHolds == 32, ] +
tmpDrawkeep4[mtxIndices[cardIndex, 2], -1][cardHolds == 32, ] -
tmpDrawkeep5[cardIndex, ][cardHolds == 32, -1]
# evSmallNoReplace[, 32] <- (choose(52, 5) * mean(aScores) -
# choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, 31]] -
# choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, 30]] -
# choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, 29]] -
# choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, 28]] -
# choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, 27]] +
# choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 26]] +
# choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 25]] +
# choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 24]] +
# choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 23]] +
# choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 22]] +
# choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 21]] +
# choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 20]] +
# choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 19]] +
# choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 18]] +
# choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 17]] -
# choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 16]] -
# choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 15]] -
# choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 14]] -
# choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 13]] -
# choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 12]] -
# choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 11]] -
# choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 10]] -
# choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 9]] -
# choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 8]] -
# choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 7]] +
# choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, 6]] +
# choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, 5]] +
# choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, 4]] +
# choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, 3]] +
# choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, 2]] -
# evSmallNoReplace[, 1]
# ) / choose(47, 5)
drawSmallNoReplace
}
# Simulate a specific pay-table given a known sequence of holds
simDrawVar <- function(aT=aType, mtxI=mtxIndices, useHolds,
cardI=cardIndex, cardW=cardWeight, startT=startTime,
grTitle="EV Draw Simulation Results", allOut=FALSE
) {
# Get the possible outcomes assuming re-draws are allowed
keyList <- calcFreq_YesRedraw(mtxIndices=mtxI, aTypes=aT)
# Next, need to adapt the code for no re-draws
drawSmallNoReplace <- drawNoReplace(cardIndex=cardI, cardHolds=useHolds,
keyList=keyList, mtxIndices=mtxI
)
if (allOut) {
return(list(drawSmallNoReplace=drawSmallNoReplace,
keyList=keyList
)
)
} else {
return(list(drawSmallNoReplace=drawSmallNoReplace
)
)
}
}Then, a functions is built to assess the overall mean, variance on the deal, variance on the draw, and distribution of the variances for a given game:
calcMeanVar <- function (tempDraws, hnd2Score, mainName, wgts=cardWeight) {
drawTemp <- tempDraws$drawSmallNoReplace[, -1]
cat("\n", "Summary of", mainName,"starting with row sums\n")
print(table(rowSums(drawTemp)))
drawOdds <- drawTemp / matrix(data=rep(rowSums(drawTemp), ncol(drawTemp)),
nrow=nrow(drawTemp), byrow=FALSE
)
print(table(rowSums(drawOdds)))
drawEV <- drawOdds %*% matrix(data=hnd2Score$val, ncol=1)
drawEV2 <- drawOdds %*% matrix(data=hnd2Score$val^2, ncol=1)
cat("\n")
print(paste0(mainName, ": Overall EV and Mean"))
print(summary(rep(drawEV, times=wgts)))
print(paste0("Overall Return: ", round(1 + mean(rep(drawEV, times=wgts)), 6)))
cat("\n")
print(paste0(mainName, ": Variances (Deal, Draw)"))
print(paste0("Deal Variance: ", round(var(rep(drawEV, times=wgts)), 4)))
print("Draw Variance Summary Statistics")
print(summary(rep(drawEV2 - drawEV^2, times=wgts)))
cat("\n")
hist(log10(1 + rep(drawEV2 - drawEV^2, times=wgts)), col="light blue",
main=paste0("Deal Variance for: ", mainName), xlab="1 + log10(Deal Variance)"
)
}Games are then simulated for variance, with the outcomes cached for run-time optimization:
# Assess JB 96 game
jb96Draws <- simDrawVar(aT=aType, mtxI=mtxIndices, useHolds=jb96List$tempSmallMax[2, ],
cardI=cardIndex, cardW=cardWeight, startT=startTime,
grTitle="EV Draw Simulation Results", allOut=FALSE
)## [1] 2598960 27
## [1] 270725 27
## [1] 22100 27
## [1] 1326 27
## [1] 52 27
## [1] 1 27
## idx 0 1 2 3 4 5 6 7 8 9 10 11
## [1,] 0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
## 12 13 14 15 16 17 18 19 20 21 22 23 24 25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1# Assess BP 85 game
bp85Draws <- simDrawVar(aT=aType, mtxI=mtxIndices, useHolds=bp85List$tempSmallMax[2, ],
cardI=cardIndex, cardW=cardWeight, startT=startTime,
grTitle="EV Draw Simulation Results", allOut=FALSE
)## [1] 2598960 27
## [1] 270725 27
## [1] 22100 27
## [1] 1326 27
## [1] 52 27
## [1] 1 27
## idx 0 1 2 3 4 5 6 7 8 9 10 11
## [1,] 0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
## 12 13 14 15 16 17 18 19 20 21 22 23 24 25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1# Assess BPD 96 game
bpd96Draws <- simDrawVar(aT=aType, mtxI=mtxIndices, useHolds=bpd96List$tempSmallMax[2, ],
cardI=cardIndex, cardW=cardWeight, startT=startTime,
grTitle="EV Draw Simulation Results", allOut=FALSE
)## [1] 2598960 27
## [1] 270725 27
## [1] 22100 27
## [1] 1326 27
## [1] 52 27
## [1] 1 27
## idx 0 1 2 3 4 5 6 7 8 9 10 11
## [1,] 0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
## 12 13 14 15 16 17 18 19 20 21 22 23 24 25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1# Assess DDB 96 game
ddb96Draws <- simDrawVar(aT=aType, mtxI=mtxIndices, useHolds=ddb96List$tempSmallMax[2, ],
cardI=cardIndex, cardW=cardWeight, startT=startTime,
grTitle="EV Draw Simulation Results", allOut=FALSE
)## [1] 2598960 27
## [1] 270725 27
## [1] 22100 27
## [1] 1326 27
## [1] 52 27
## [1] 1 27
## idx 0 1 2 3 4 5 6 7 8 9 10 11
## [1,] 0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
## 12 13 14 15 16 17 18 19 20 21 22 23 24 25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1# Assess the TDB 96 game
tdb96Draws <- simDrawVar(aT=aType, mtxI=mtxIndices, useHolds=tdb96List$tempSmallMax[2, ],
cardI=cardIndex, cardW=cardWeight, startT=startTime,
grTitle="EV Draw Simulation Results", allOut=FALSE
)## [1] 2598960 27
## [1] 270725 27
## [1] 22100 27
## [1] 1326 27
## [1] 52 27
## [1] 1 27
## idx 0 1 2 3 4 5 6 7 8 9 10 11
## [1,] 0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
## 12 13 14 15 16 17 18 19 20 21 22 23 24 25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1And, the function is then applied to each of the games:
calcMeanVar(tempDraws=jb96Draws, hnd2Score=jb96hnd2Score, mainName="JB 96")##
## Summary of JB 96 starting with row sums
##
## 1 47 1081 16215 178365 1533939
## 2210 18081 9557 82107 18659 3845
##
## 1
## 134459
##
## [1] "JB 96: Overall EV and Mean"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6426 -0.5175 -0.1763 -0.0046 0.1489 799.0000
## [1] "Overall Return: 0.995439"
##
## [1] "JB 96: Variances (Deal, Draw)"
## [1] "Deal Variance: 1.9664"
## [1] "Draw Variance Summary Statistics"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 2.579 3.549 17.550 4.465 13290.000
calcMeanVar(tempDraws=bp85Draws, hnd2Score=bp85hnd2Score, mainName="BP 85")##
## Summary of BP 85 starting with row sums
##
## 1 47 1081 16215 178365 1533939
## 2210 18052 9450 81980 18922 3845
##
## 1
## 134459
##
## [1] "BP 85: Overall EV and Mean"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6434 -0.5183 -0.1865 -0.0083 -0.0426 799.0000
## [1] "Overall Return: 0.99166"
##
## [1] "BP 85: Variances (Deal, Draw)"
## [1] "Deal Variance: 2.12"
## [1] "Draw Variance Summary Statistics"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 2.437 3.392 18.780 5.854 13300.000
calcMeanVar(tempDraws=bpd96Draws, hnd2Score=bpd96hnd2Score, mainName="BPD 96")##
## Summary of BPD 96 starting with row sums
##
## 1 47 1081 16215 178365 1533939
## 2210 20557 9361 80678 19219 2434
##
## 1
## 134459
##
## [1] "BPD 96: Overall EV and Mean"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6770 -0.5528 -0.1835 -0.0036 0.1489 799.0000
## [1] "Overall Return: 0.996417"
##
## [1] "BPD 96: Variances (Deal, Draw)"
## [1] "Deal Variance: 3.6851"
## [1] "Draw Variance Summary Statistics"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 4.983 18.150 28.450 19.110 13290.000
calcMeanVar(tempDraws=ddb96Draws, hnd2Score=ddb96hnd2Score, mainName="DDB 96")##
## Summary of DDB 96 starting with row sums
##
## 1 47 1081 16215 178365 1533939
## 2150 19685 9757 72889 27544 2434
##
## 1
## 134459
##
## [1] "DDB 96: Overall EV and Mean"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6770 -0.5414 -0.2668 -0.0102 0.1489 799.0000
## [1] "Overall Return: 0.989808"
##
## [1] "DDB 96: Variances (Deal, Draw)"
## [1] "Deal Variance: 4.809"
## [1] "Draw Variance Summary Statistics"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 5.080 8.414 37.180 20.000 13290.000
calcMeanVar(tempDraws=tdb96Draws, hnd2Score=tdb96hnd2Score, mainName="TDB 96")##
## Summary of TDB 96 starting with row sums
##
## 1 47 1081 16215 178365 1533939
## 2078 21102 14619 70233 24931 1496
##
## 1
## 134459
##
## [1] "TDB 96: Overall EV and Mean"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6952 -0.5391 -0.3811 -0.0185 0.1489 799.0000
## [1] "Overall Return: 0.98154"
##
## [1] "TDB 96: Variances (Deal, Draw)"
## [1] "Deal Variance: 10.6774"
## [1] "Draw Variance Summary Statistics"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00 4.99 8.00 89.44 50.05 77880.00
The differences in means and variances are evident:
- JB 96: 99.54% 1.97 + 17.55 = 19.52
- BP 85: 99.17% 2.12 + 18.78 = 20.90
- BPD 96: 99.64% 3.69 + 28.45 = 32.14
- DDB 96: 98.98% 4.81 + 37.18 = 41.99
- TDB 96: 98.15% 10.68 + 89.44 = 100.12
So, the overall mean (99.544%) and variance on the deal (17.55) for JB 96 match theoretical. Similarly, the overall mean (99.17%) and variance on the deal (18.78) for BP 85 match tehoretical. And, the overall mean (98.15%) for TDB 96 matches theoretical, with an extremely large (89.44) variance on the deal.
All else equal, the variance of TDB 96 is ~5x the variance of JB 96 / BP 85, and with a lower starting return. Further, the “average” variance is itself very spiky, comprised of starting hands that vary as much as ~1000x greater than the average!
Next, the individual means and variances for the starting hands of a given game are explored:
indMeanVar <- function(hnd2Score, listDraws, useName,
cIndex=cardIndex, cWeight=cardWeight, allOut=FALSE
) {
# Get the vector of outcomes for each starting hand (no longer concerned with all 25)
possOutcomes <- unique(hnd2Score$val)
mtxOutcomes <- matrix(data=0L, nrow=length(cIndex), ncol=length(possOutcomes)+2)
# Probably should have created the unique key in the functions; will want it here, so add it
mtxOutcomes[, 1] <- cIndex
mtxOutcomes[, 2] <- cWeight
cat("\n\nThis will assess the", useName, "means and variances\n\n")
# Next, work through each possible outcome for the draws
for (intCtr in seq_along(possOutcomes)) {
keyCol <- hnd2Score$idx[hnd2Score$val == possOutcomes[intCtr]] + 2
cat(intCtr, possOutcomes[intCtr], keyCol, "\n")
mtxOutcomes[, intCtr + 2] <- rowSums(listDraws$drawSmallNoReplace[, keyCol, drop=FALSE])
}
# Next, see how many starting hand types there are, considering any starting hands
# that generate the identical outcomes vector to be indetical for these purposes
print(nrow(unique(mtxOutcomes[, -(1:2)])))
# Next, create histograms by the row sums (which is analogous to number of cards held)
mtxUnique <- unique(mtxOutcomes[, -(1:2)])
str(mtxUnique)
data.frame(rSum=rowSums(mtxUnique)) %>%
group_by(rSum) %>%
summarize(ct=n()) %>%
print.data.frame()
# Next, create the mean and variance (of the draw) for each of the unique hands
# Further, summarize these split by hand type
myUniqueFrame <- data.frame(rSum=rowSums(mtxUnique),
possSum=mtxUnique %*% possOutcomes,
possSum2=mtxUnique %*% possOutcomes^2
)
myUniqueFrame$uqMean <- myUniqueFrame$possSum / myUniqueFrame$rSum
myUniqueFrame$uqVar <- (myUniqueFrame$possSum2 / myUniqueFrame$rSum) - myUniqueFrame$uqMean^2
# Send back the unique frame to whoever called the function
# STILL NEED TO GET THIS TO ADD THE WEIGHTS by Hand Types!!!
charAll <- apply(mtxOutcomes[, -(1:2)], 1, FUN=paste0, collapse="-")
charUnique <- apply(mtxUnique, 1, FUN=paste0, collapse="-")
str(charAll)
str(charUnique)
charMatch <- match(charAll, charUnique)
str(charMatch)
# print(summary(charMatch))
sumUnique <- tapply(cWeight, charMatch, FUN=sum)
str(sumUnique)
# print(summary(sumUnique))
myUniqueCards <- cbind(mtxUnique, sumUnique)
if (!isTRUE(allOut)) {
list(uqFrame=myUniqueFrame)
} else {
list(uqFrame=myUniqueFrame,
uqCards=myUniqueCards,
mapOuts=possOutcomes
)
}
}Then, the function is run for JB 96, BP 85, BPD 96, DDB 96, and TDB 96, preserving the key counts for all of the relevant unique hands (cached to improve run times):
jb96UniqueList <- indMeanVar(hnd2Score=jb96hnd2Score, listDraws=jb96Draws,
useName="JB 96", allOut=TRUE
)##
##
## This will assess the JB 96 means and variances
##
## 1 -1 2 14 15
## 2 799 3
## 3 49 4
## 4 8 5
## 5 5 6
## 6 3 7
## 7 2 8
## 8 1 9
## 9 0 10 11 12 13
## 10 24 16 17 18 19 20 21 22 23 24 25 26 27
## [1] 1279
## num [1:1279, 1:10] 0 0 0 0 33 ...
## rSum ct
## 1 1 6
## 2 47 34
## 3 1081 105
## 4 16215 104
## 5 178365 155
## 6 1533939 875
## chr [1:134459] "0-0-0-0-0-0-0-0-0-1" "0-0-0-0-0-0-0-0-0-1" ...
## chr [1:1279] "0-0-0-0-0-0-0-0-0-1" "0-0-0-1-0-0-0-0-0-0" ...
## int [1:134459] 1 1 1 1 1 1 1 1 1 1 ...
## num [1:1279(1d)] 624 3744 54912 123552 96 ...
## - attr(*, "dimnames")=List of 1
## ..$ : chr [1:1279] "1" "2" "3" "4" ...bp85UniqueList <- indMeanVar(hnd2Score=bp85hnd2Score, listDraws=bp85Draws,
useName="BP 85", allOut=TRUE
)##
##
## This will assess the BP 85 means and variances
##
## 1 -1 2 14 15
## 2 799 3
## 3 49 4
## 4 7 5
## 5 4 6
## 6 3 7
## 7 2 8
## 8 1 9
## 9 0 10 11 12 13
## 10 79 16 17 18
## 11 39 19 20 21 22
## 12 24 23 24 25 26 27
## [1] 1647
## num [1:1647, 1:12] 0 0 0 0 0 0 0 0 33 0 ...
## rSum ct
## 1 1 8
## 2 47 34
## 3 1081 106
## 4 16215 95
## 5 178365 451
## 6 1533939 953
## chr [1:134459] "0-0-0-0-0-0-0-0-0-1-0-0" ...
## chr [1:1647] "0-0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-0-0-1-0" ...
## int [1:134459] 1 1 1 1 1 1 1 1 1 1 ...
## num [1:1647(1d)] 48 144 432 3744 4224 ...
## - attr(*, "dimnames")=List of 1
## ..$ : chr [1:1647] "1" "2" "3" "4" ...bpd96UniqueList <- indMeanVar(hnd2Score=bpd96hnd2Score, listDraws=bpd96Draws,
useName="BPD 96", allOut=TRUE
)##
##
## This will assess the BPD 96 means and variances
##
## 1 -1 2 14 15
## 2 799 3
## 3 49 4
## 4 8 5
## 5 5 6
## 6 3 7
## 7 2 8
## 8 0 9 10 11 12 13
## 9 79 16 17 18 19 20 21 22 23 24 25 26 27
## [1] 851
## num [1:851, 1:9] 0 0 0 0 33 ...
## rSum ct
## 1 1 6
## 2 47 36
## 3 1081 104
## 4 16215 95
## 5 178365 158
## 6 1533939 452
## chr [1:134459] "0-0-0-0-0-0-0-0-1" "0-0-0-0-0-0-0-0-1" ...
## chr [1:851] "0-0-0-0-0-0-0-0-1" "0-0-0-1-0-0-0-0-0" ...
## int [1:134459] 1 1 1 1 1 1 1 1 1 1 ...
## num [1:851(1d)] 624 3744 54912 123552 96 ...
## - attr(*, "dimnames")=List of 1
## ..$ : chr [1:851] "1" "2" "3" "4" ...ddb96UniqueList <- indMeanVar(hnd2Score=ddb96hnd2Score, listDraws=ddb96Draws,
useName="DDB 96", allOut=TRUE
)##
##
## This will assess the DDB 96 means and variances
##
## 1 -1 2 14 15
## 2 799 3
## 3 49 4 23 24 25 26 27
## 4 8 5
## 5 5 6
## 6 3 7
## 7 2 8
## 8 0 9 10 11 12 13
## 9 399 16
## 10 159 17 18 19 20
## 11 79 21 22
## [1] 1260
## num [1:1260, 1:11] 0 0 0 0 0 0 0 0 0 0 ...
## rSum ct
## 1 1 7
## 2 47 38
## 3 1081 118
## 4 16215 94
## 5 178365 507
## 6 1533939 496
## chr [1:134459] "0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-1-0-0" ...
## chr [1:1260] "0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-12-35-0" ...
## int [1:134459] 1 1 1 2 2 2 2 2 2 2 ...
## num [1:1260(1d)] 12 36 36 108 468 ...
## - attr(*, "dimnames")=List of 1
## ..$ : chr [1:1260] "1" "2" "3" "4" ...tdb96UniqueList <- indMeanVar(hnd2Score=tdb96hnd2Score, listDraws=tdb96Draws,
useName="TDB 96", allOut=TRUE
)##
##
## This will assess the TDB 96 means and variances
##
## 1 -1 2 14 15
## 2 799 3 16
## 3 49 4 23 24 25 26 27
## 4 8 5
## 5 5 6
## 6 3 7
## 7 1 8
## 8 0 9 10 11 12 13
## 9 159 17 18
## 10 399 19 20
## 11 79 21 22
## [1] 945
## num [1:945, 1:11] 0 0 0 0 0 0 0 0 0 0 ...
## rSum ct
## 1 1 6
## 2 47 43
## 3 1081 140
## 4 16215 83
## 5 178365 369
## 6 1533939 304
## chr [1:134459] "0-1-0-0-0-0-0-0-0-0-0" "0-1-0-0-0-0-0-0-0-0-0" ...
## chr [1:945] "0-1-0-0-0-0-0-0-0-0-0" "0-12-0-0-0-0-0-0-35-0-0" ...
## int [1:134459] 1 1 1 2 2 2 2 2 2 2 ...
## num [1:945(1d)] 16 36 36 108 468 ...
## - attr(*, "dimnames")=List of 1
## ..$ : chr [1:945] "1" "2" "3" "4" ...With a “flavor” being defined as the full class of starting hands that have an identical payout vector, the following number of flavors are observed per game:
- JB 96 - 1,279 flavors
- BP 85 - 1,647 flavors (increase due to different types of quads)
- BPD 96 - 851 flavors (decrease due to fewer 0-card holds, which tends to be a high-flavor if rare hold)
- DDB 96 - 1,260 flavors (like BPD 96 but with more flavors of quads)
TDB 96 - 945 flavors
- “Hold 5” flavors by game - JB (6), BP(8), BPD(6), DDB(7), TDB (6)
- “Hold 4” flavors by game - JB (34), BP(34), BPD(36), DDB(38), TDB (43)
- “Hold 3” flavors by game - JB (105), BP(106), BPD(104), DDB(118), TDB (140)
- “Hold 2” flavors by game - JB (104), BP(95), BPD(95), DDB(94), TDB (83)
- “Hold 1” flavors by game - JB (155), BP(451), BPD(158), DDB(507), TDB (369)
“Hold 0” flavors by game - JB (875), BP(953), BPD(452), DDB(496), TDB (304)
While hold 0 is the rarest of the starting hands, it contains the most “flavors” of JB 96 since there are many different “penalties” to straights and flushes that may have been discarded. On the other hand, since TDB 96 will frequently go for long-shots (inside straight draws), there are even fewer flavors of hold 0, but more flavors of hold 4, hold 3, and (especially) hold 1.
Next, a function is created for graphing the various outcomes:
graphMeanVar <- function(useFrame, useName) {
# Hold all 5
dummy <- useFrame[useFrame$rSum == choose(47, 0), ]
plot(x=log10(1+sqrt(dummy$uqVar)), y=log10(2+dummy$uqMean), col="dark green", pch=19,
xlab="Log10 of [1+SD] (SQRT of Variance)", ylab="Log 10 of [2+Mean]",
main=paste("Outcomes of Starting Flavors for", useName),
xlim=c(0, log10(100 * max(ceiling(sqrt(useFrame$uqVar)/100)))), ylim=c(0, 3)
)
# Hold 4 of 5
dummy <- useFrame[useFrame$rSum == choose(47, 1), ]
points(x=log10(1+sqrt(dummy$uqVar)), y=log10(2+dummy$uqMean), col="light green", pch=19)
# Hold 3 of 5
dummy <- useFrame[useFrame$rSum == choose(47, 2), ]
points(x=log10(1+sqrt(dummy$uqVar)), y=log10(2+dummy$uqMean), col="purple", pch=19)
# Hold 2 of 5
dummy <- useFrame[useFrame$rSum == choose(47, 3), ]
points(x=log10(1+sqrt(dummy$uqVar)), y=log10(2+dummy$uqMean), col="blue", pch=19)
# Hold 1 of 5
dummy <- useFrame[useFrame$rSum == choose(47, 4), ]
points(x=log10(1+sqrt(dummy$uqVar)), y=log10(2+dummy$uqMean), col="orange", pch=19)
# Hold 0 of 5
dummy <- useFrame[useFrame$rSum == choose(47, 5), ]
points(x=log10(1+sqrt(dummy$uqVar)), y=log10(2+dummy$uqMean), col=rgb(1, 0, 0, 0.25), pch=19)
legend("top", legend=paste("Hold", 5:0), pch=19, ncol=3,
col=c("dark green", "light green", "purple", "blue", "orange", "red")
)
abline(h=log10(2+c(-1, 0, 2)), lty=2)
abline(v=log10(1+c(1.5, 4)), lty=2)
}The function is then run for JB 96, BP 85, BPD 96, DDB 96, and TDB 96:
graphMeanVar(useFrame=jb96UniqueList$uqFrame, useName="JB 96")
graphMeanVar(useFrame=bp85UniqueList$uqFrame, useName="BP 85")
graphMeanVar(useFrame=bpd96UniqueList$uqFrame, useName="BPD 96")
graphMeanVar(useFrame=ddb96UniqueList$uqFrame, useName="DDB 96")
graphMeanVar(useFrame=tdb96UniqueList$uqFrame, useName="TDB 96")
The draws can then be assessed as in several classes for JB 96:
- High mean, zero variance - all hold 5
- High-medium mean, very high variance - handful of hold 3/4
- Medium mean, medium-high variance - handful of hold 2/4
- Low mean, very high variance - handful of hold 2
- Low mean, high variance - handful of hold 1/3
- Low mean, medium variance - handful of hold 2/3/4, and all hold 5
- Low mean, low variance - handful of hold 1/2
Categorized differently (still for JB 96):
- Hold 5 - always high mean and zero variance
- Hold 4 - mean and variance range from low to very high, with mean and variance correlated
- Hold 3 - generally medium-high variance with medium-low mean
- Hold 2 - generally medium-high variance with medium-low mean
- Hold 1 - generally low-medium variance and low mean
- Hold 0 - low mean, medium variance
Notably, the DDB 96 and TDB 96 games have many higher variance holds, consistent with overall high variance.
Next, pre-processing is run to begin assessing the impact of N-play (1 deal, 1 hold, N iid draws). The impact of N-play can be calculated only once for each “flavor” of hands, then weighted by the likelihood of being dealt that flavor:
assessFlavor <- function(uqList) {
lastCol <- ncol(uqList$uqCards)
keyCounts <- uqList$uqCards[, lastCol]
# Check that means and variances of the draw still make sense
print(1 + weighted.mean(uqList$uqFrame$uqMean, w=keyCounts))
print(weighted.mean(uqList$uqFrame$uqVar, w=keyCounts))
# Report on the number of hands by cards held
totVar <- sum(uqList$uqFrame$uqVar * keyCounts)
cbind(uqList$uqFrame, keyCounts) %>%
group_by(rSum) %>%
summarize(nFlv=n(), nH=sum(keyCounts),
sumFlv=sum(keyCounts*uqMean),
meanFlv=round(sumFlv/nH, 5),
contFlv=round(sumFlv/choose(52, 5), 5),
varFMean=round(sum(keyCounts*uqVar)/nH, 1),
varFPct=round(sum(keyCounts*uqVar)/totVar, 3)
)
}
assessFlavor(uqList=jb96UniqueList)## [1] 0.995439
## [1] 17.54829## # A tibble: 6 × 8
## rSum nFlv nH sumFlv meanFlv contFlv varFMean varFPct
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 6 19488 105032.00 5.38957 0.04041 0.0 0.000
## 2 47 34 292176 216684.68 0.74162 0.08337 47.4 0.304
## 3 1081 105 147528 163004.83 1.10491 0.06272 120.6 0.390
## 4 16215 104 1651440 -230169.16 -0.13937 -0.08856 7.3 0.263
## 5 178365 155 403968 -212398.17 -0.52578 -0.08172 4.4 0.039
## 6 1533939 875 84360 -54007.92 -0.64021 -0.02078 2.2 0.004assessFlavor(uqList=bp85UniqueList)## [1] 0.9916597
## [1] 18.78406## # A tibble: 6 × 8
## rSum nFlv nH sumFlv meanFlv contFlv varFMean varFPct
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 8 19488 101136.00 5.18966 0.03891 0.0 0.000
## 2 47 34 292236 188180.68 0.64393 0.07241 46.5 0.278
## 3 1081 106 144876 176284.64 1.21680 0.06783 135.3 0.402
## 4 16215 95 1649040 -218231.79 -0.13234 -0.08397 8.2 0.277
## 5 178365 451 408960 -214931.49 -0.52556 -0.08270 4.7 0.039
## 6 1533939 953 84360 -54114.06 -0.64147 -0.02082 2.4 0.004assessFlavor(uqList=bpd96UniqueList)## [1] 0.9964171
## [1] 28.44891## # A tibble: 6 × 8
## rSum nFlv nH sumFlv meanFlv contFlv varFMean varFPct
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 6 19488 139352.00 7.15066 0.05362 0.0 0.000
## 2 47 36 345240 73465.96 0.21280 0.02827 40.8 0.190
## 3 1081 104 145128 288665.96 1.98904 0.11107 196.4 0.386
## 4 16215 95 1620144 -242281.79 -0.14954 -0.09322 17.7 0.388
## 5 178365 158 416148 -232882.18 -0.55961 -0.08961 5.9 0.033
## 6 1533939 452 52812 -35631.74 -0.67469 -0.01371 3.4 0.002assessFlavor(uqList=ddb96UniqueList)## [1] 0.9898078
## [1] 37.17596## # A tibble: 6 × 8
## rSum nFlv nH sumFlv meanFlv contFlv varFMean varFPct
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 7 19056 119432.00 6.26742 0.04595 0.0 0.000
## 2 47 38 329196 78302.21 0.23786 0.03013 44.1 0.150
## 3 1081 118 152112 277092.73 1.82164 0.10662 235.3 0.370
## 4 16215 94 1443696 -133696.55 -0.09261 -0.05144 26.9 0.402
## 5 178365 507 602088 -331961.20 -0.55135 -0.12773 12.0 0.075
## 6 1533939 496 52812 -35658.22 -0.67519 -0.01372 4.3 0.002assessFlavor(uqList=tdb96UniqueList)## [1] 0.98154
## [1] 89.43734## # A tibble: 6 × 8
## rSum nFlv nH sumFlv meanFlv contFlv varFMean varFPct
## <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 6 18192 125960.00 6.92392 0.04847 0.0 0.000
## 2 47 43 353088 178522.64 0.50560 0.06869 184.1 0.280
## 3 1081 140 244260 154150.68 0.63109 0.05931 228.1 0.240
## 4 16215 83 1389840 -171163.78 -0.12315 -0.06586 68.0 0.407
## 5 178365 369 557676 -310617.30 -0.55699 -0.11952 30.3 0.073
## 6 1533939 304 35904 -24829.14 -0.69154 -0.00955 8.4 0.001Next, the total potential outcomes are calculated:
totOutcomes <- function(keyList, useName) {
# Convert each row so it sums to 5 * choose(47, 5) * cardWeight
# (which is in the final column)
keyFrame <- keyList$uqCards
mapScore <- keyList$mapOuts
lastCol <- ncol(keyFrame)
keySums <- rowSums(keyFrame[, -lastCol])
keyMult <- 5 * choose(47, 5) / keySums
useFrame <- keyFrame[, -lastCol]
for (intCtr in 1:(lastCol-1)) {
useFrame[, intCtr] <- keyFrame[, intCtr] * keyMult * keyFrame[, lastCol]
}
# Get the percentages by outcome
showTable <- data.frame(scoreType=mapScore,
occPer=sum(useFrame) / colSums(useFrame),
contRet=colSums(useFrame) * mapScore / sum(useFrame)
)
showTable$occFreq <- 1/showTable$occPer
showTable <- showTable[order(-showTable$scoreType), ]
printShowTable <- showTable
printShowTable$occPer <- signif(showTable$occPer, 4)
printShowTable$contRet <- round(showTable$contRet, 6)
printShowTable$occFreq <- round(showTable$occFreq, 8)
print(printShowTable)
psEX <- sum(printShowTable$contRet)
psEX2 <- sum(printShowTable$occFreq * printShowTable$scoreType^2) / sum(printShowTable$occFreq)
cat("\nPrinted table suggests", useName, "mean return:", 1+psEX,
"and overall variance:", psEX2 - psEX^2, "\n\n"
)
}
totOutcomes(keyList=jb96UniqueList, useName="JB 96")## scoreType occPer contRet occFreq
## 2 799 40390.000 0.019782 0.00002476
## 3 49 9148.000 0.005356 0.00010931
## 10 24 423.300 0.056701 0.00236255
## 4 8 86.860 0.092098 0.01151221
## 5 5 90.790 0.055073 0.01101451
## 6 3 89.050 0.033688 0.01122937
## 7 2 13.430 0.148897 0.07444870
## 8 1 7.735 0.129279 0.12927890
## 9 0 4.660 0.000000 0.21458503
## 1 -1 1.833 -0.545435 0.54543467
##
## Printed table suggests JB 96 mean return: 0.995439 and overall variance: 19.51579totOutcomes(keyList=bp85UniqueList, useName="BP 85")## scoreType occPer contRet occFreq
## 2 799 40230.000 0.019859 0.00002486
## 10 79 5106.000 0.015472 0.00019584
## 3 49 9360.000 0.005235 0.00010684
## 11 39 1897.000 0.020563 0.00052725
## 12 24 609.800 0.039357 0.00163990
## 4 7 86.850 0.080600 0.01151428
## 5 4 91.910 0.043520 0.01088000
## 6 3 89.120 0.033664 0.01122128
## 7 2 13.430 0.148936 0.07446817
## 8 1 7.733 0.129308 0.12930787
## 9 0 4.646 0.000000 0.21525919
## 1 -1 1.835 -0.544855 0.54485452
##
## Printed table suggests BP 85 mean return: 0.991659 and overall variance: 20.90718totOutcomes(keyList=bpd96UniqueList, useName="BPD 96")## scoreType occPer contRet occFreq
## 2 799 42080.000 0.018989 0.00002377
## 9 79 423.800 0.186417 0.00235970
## 3 49 9173.000 0.005342 0.00010902
## 4 8 87.040 0.091917 0.01148960
## 5 5 89.920 0.055603 0.01112054
## 6 3 78.250 0.038339 0.01277965
## 7 2 13.500 0.148182 0.07409082
## 8 0 2.944 0.000000 0.33965643
## 1 -1 1.824 -0.548370 0.54837048
##
## Printed table suggests BPD 96 mean return: 0.996419 and overall variance: 32.13652totOutcomes(keyList=ddb96UniqueList, useName="DDB 96")## scoreType occPer contRet occFreq
## 2 799 40800.000 0.019584 0.00002451
## 9 399 16240.000 0.024574 0.00006159
## 10 159 3157.000 0.050367 0.00031678
## 11 79 2601.000 0.030368 0.00038441
## 3 49 574.800 0.085249 0.00173978
## 4 8 92.080 0.086880 0.01086000
## 5 5 88.040 0.056793 0.01135853
## 6 3 78.330 0.038299 0.01276626
## 7 2 13.290 0.150530 0.07526513
## 8 0 2.991 0.000000 0.33438608
## 1 -1 1.809 -0.552837 0.55283693
##
## Printed table suggests DDB 96 mean return: 0.989807 and overall variance: 41.98492totOutcomes(keyList=tdb96UniqueList, useName="TDB 96")## scoreType occPer contRet occFreq
## 2 799 10460.000 0.076366 0.00009558
## 10 399 5796.000 0.068844 0.00017254
## 9 159 6723.000 0.023649 0.00014874
## 11 79 3126.000 0.025276 0.00031994
## 3 49 581.300 0.084287 0.00172014
## 4 8 95.670 0.083624 0.01045301
## 5 5 78.670 0.063555 0.01271096
## 6 3 73.910 0.040587 0.01352916
## 7 1 13.400 0.074605 0.07460540
## 8 0 3.058 0.000000 0.32699061
## 1 -1 1.788 -0.559254 0.55925391
##
## Printed table suggests TDB 96 mean return: 0.981539 and overall variance: 100.1161Next, a function is written to look at N-play (defaulted to 3-play and limited to 1-5 or 10 play):
assessNPlay <- function(keyList, nPlay=3L) {
hnd2Value <- keyList$mapOuts
uqCol <- ncol(keyList$uqCards)
cWeight <- keyList$uqCards[, uqCol]
uqHands <- keyList$uqCards[, -uqCol]
# Only allow nPlay of 1-5 or 10 for now (need to improve algorithm otherwise)
if (nPlay > 10) {
print("Cannot have nPlay > 10, will be re-set to 10")
nPlay <- 10L
nBase <- 5L # Run it as a 5-play draw multiplied due to vector sizes/memory
} else if (nPlay == 10) {
print("nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed")
nBase <- 5L # Run it as a 5-play draw multiplied due to vector sizes/memory
} else if (nPlay > 5) {
print("Only nPlay of 1-5 or 10 may be used, will be re-set to 5")
nPlay <- 5L
nBase <- 5L
} else if (nPlay < 1) {
print("Cannot have nPlay < 1, will be re-set to 1")
nPlay <- 1L
nBase <- 1L
} else if (!all.equal(as.integer(nPlay), nPlay)) {
print("nPlay will be coerced to an integer")
nPlay <- as.integer(nPlay)
nBase <- nPlay
} else {
nBase <- nPlay
}
mtxNPlay <- matrix(data=0, nrow=(uqCol-1)^nBase, ncol=(2+nBase),
dimnames=list(NULL, c("Value", "Freq", paste0("C", 1:nBase)))
)
# Find and store the key positions
cNum <- vector("list", length=nBase)
for (intCtr in 1:nBase) {
cNum[[intCtr]] <- rep(rep(1:(uqCol-1), each=(uqCol-1)^(nBase-intCtr)
), times=(uqCol-1)^(intCtr-1)
)
}
str(cNum)
# Populate the value of the key positions
for (intCtr in 1:nBase) {
mtxNPlay[, (intCtr+2)] <- hnd2Value[cNum[[intCtr]]]
}
# Populate the overall value of the outcome
mtxNPlay[, 1] <- rowSums(mtxNPlay[, -(1:2), drop=FALSE])
# Populate the overall frequencies of the outcome
uqSums <- rowSums(uqHands)
mtxFreqs <- uqHands / uqSums[row(uqHands)]
print(table(rowSums(mtxFreqs)))
cVec <- sapply(cNum, FUN=function(x) { as.vector(x) })
str(cVec)
print(head(cVec))
# See the number of unique outcomes
cat("\n\nNumber of unique outcome types:", length(table(mtxNPlay[, 1])), "\n")
# Calculate the possible ways to get a particular outcome
dfOutcome <- data.frame(nOutcome=mtxNPlay[, 1]) %>%
group_by(nOutcome) %>% summarize(ct=n())
dfOutcome$wts <- 0
vecRow <- as.vector(row(mtxNPlay[, 1, drop=FALSE]))
mtxNFirst <- mtxNPlay[, 1, drop=TRUE]
keyOutcome <- dfOutcome$nOutcome
# Create all the 2-column multiplications
mtxFreq_2x2 <- matrix(data=NA, nrow=nrow(mtxFreqs), ncol=ncol(mtxFreqs)^2)
grid_2x2 <- expand.grid(1:ncol(mtxFreqs), 1:ncol(mtxFreqs))
for (intCtr in 1:nrow(grid_2x2)) {
c1 <- grid_2x2[intCtr, 1]
c2 <- grid_2x2[intCtr, 2]
mtxFreq_2x2[, intCtr] <- mtxFreqs[, c1] * mtxFreqs[, c2]
}
# Create all the 3-column multiplications
mtxFreq_3x3 <- matrix(data=NA, nrow=nrow(mtxFreqs), ncol=ncol(mtxFreqs)^3)
grid_3x3 <- expand.grid(1:ncol(mtxFreqs), 1:ncol(mtxFreqs), 1:ncol(mtxFreqs))
for (intCtr in 1:nrow(grid_3x3)) {
c1 <- grid_3x3[intCtr, 1]
c2 <- grid_3x3[intCtr, 2]
c3 <- grid_3x3[intCtr, 3]
mtxFreq_3x3[, intCtr] <- mtxFreqs[, c1] * mtxFreqs[, c2] * mtxFreqs[, c3]
}
cat("\nMoving to assess the:", nrow(dfOutcome), "rows of outcomes\n")
# Use a work-around specific to 5/10-play (expand and generalize the logic later)
if (nPlay %in% c(5, 10)) {
storeOutcomes <- matrix(data=NA, nrow=nrow(mtxFreqs), ncol=length(dfOutcome$nOutcome))
for (intCtr in 1:nrow(dfOutcome)) {
# Find the key outcome
keyOut <- keyOutcome[intCtr]
# Get the row numbers of cVec that will be associated to the key outcome
keyRow <- vecRow[mtxNFirst == keyOut]
# Convert these row numbers to the relevant 3x3 and 2x2 lookups
ncKey <- ncol(mtxFreqs)
keyMtx <- cVec[keyRow, , drop=FALSE]
col_3x3 <- 1 + (keyMtx[, 1] - 1 + ncKey * (keyMtx[, 2] - 1) + ncKey^2 * (keyMtx[, 3] - 1))
col_2x2 <- 1 + (keyMtx[, 4] - 1 + ncKey * (keyMtx[, 5] - 1))
# Use the lookups to get the key values
mtxApply <-
mtxFreq_3x3[, col_3x3, drop=FALSE] * mtxFreq_2x2[, col_2x2, drop=FALSE]
if (intCtr %% 100 == 0) {
str(mtxApply)
str(rowSums(mtxApply))
print(intCtr)
}
dfOutcome$wts[intCtr] <- dfOutcome$wts[intCtr] + sum(cWeight * rowSums(mtxApply))
storeOutcomes[, intCtr] <- rowSums(mtxApply)
}
} else {
storeOutcomes <- NULL # Not needed for these hands (nPlay of 1-4)
for (intCtr in 1:nrow(dfOutcome)) {
# Find the key outcome
keyOut <- keyOutcome[intCtr]
# Get the row numbers of cVec that will be associated to the key outcome
keyRow <- vecRow[mtxNFirst == keyOut]
mtxKey <- array(data=mtxFreqs[, t(cVec[keyRow, , drop=FALSE]), drop=FALSE],
dim=c(nrow(mtxFreqs), nPlay, length(keyRow))
)
mtxApply <- apply(mtxKey, c(1, 3), FUN=prod)
if (intCtr %% 100 == 0) {
str(mtxKey)
str(mtxApply)
str(rowSums(mtxApply))
print(intCtr)
}
dfOutcome$wts[intCtr] <- dfOutcome$wts[intCtr] + sum(cWeight * rowSums(mtxApply))
}
}
if (nPlay %in% c(1, 2, 3, 4, 5)) {
# Mean expressed on a percentage basis
# keyMean <- sum(mtxNPlay[, 2] * mtxNPlay[, 1]) / sum(mtxNPlay[, 2])
keyMean <- sum(dfOutcome$wts * dfOutcome$nOutcome) / sum(dfOutcome$wts)
cat("\n\nMean:", 1 + keyMean/nPlay) # To move this back to a "per full bet" basis
# Variance expressed as the overall variance per "base unit"
# keyVar <- sum(mtxNPlay[, 2] * mtxNPlay[, 1]^2) / sum(mtxNPlay[, 2]) - keyMean^2
keyVar <- sum(dfOutcome$wts * dfOutcome$nOutcome^2) / sum(dfOutcome$wts) - keyMean^2
cat("\t\tVariance:", keyVar, "\n") # Leave this "as is"; it is the full variance amount
out10Play <- NULL
} else if (nPlay %in% c(10)) {
# Matrix multiply the key starting outcome hands
mtxOutcomeProbs <- t(storeOutcomes * cWeight) %*% storeOutcomes
mtxOutcomeValues <- dfOutcome$nOutcome[row(mtxOutcomeProbs)] +
dfOutcome$nOutcome[col(mtxOutcomeProbs)]
# Make the out10Play frame using dplyr
out10Play <- data.frame(nOutcome=mtxOutcomeValues,
s_wts=as.vector(mtxOutcomeProbs)
) %>%
group_by(nOutcome) %>%
summarize(wts=sum(s_wts))
# Find the potential results (perhaps matricize . . .)
# out10Play <- data.frame(nOutcome=sort(unique(grid10$sumRes)), wts=0)
# for (intCtr in 1:nrow(grid10)) {
# keyVal <- storeOutcomes[, grid10$Var1[intCtr]] * storeOutcomes[, grid10$Var2[intCtr]]
# out10Spot <- which(out10Play$nOutcome == grid10$sumRes[intCtr])
# out10Play$wts[out10Spot] <- out10Play$wts[out10Spot] + sum(cWeight * keyVal)
# }
# Report back on the mean and the variance
# Mean expressed on a percentage basis
keyMean <- sum(out10Play$wts * out10Play$nOutcome) / sum(out10Play$wts)
cat("\n\nMean:", 1 + keyMean/nPlay) # To move this back to a "per full bet" basis
# Variance expressed as the overall variance per "base unit"
keyVar <- sum(out10Play$wts * out10Play$nOutcome^2) / sum(out10Play$wts) - keyMean^2
cat("\t\tVariance:", keyVar, "\n") # Leave this "as is"; it is the full variance amount
# Convert back to a pure data frame
out10Play <- as.data.frame(out10Play)
}
list(dfOutcome=dfOutcome, mtxNPlay=mtxNPlay,
storeOutcomes=storeOutcomes, out10Play=out10Play
)
}The actual runs are cached since multiple methodologies are tested later and this portion is no longer being modified:
# Run as 1/3/5-play for JB 96, BP 85, BPD 96, DDB 96, and TDB 96
jb96_1Play <- assessNPlay(keyList=jb96UniqueList, nPlay=1L)## List of 1
## $ : int [1:10] 1 2 3 4 5 6 7 8 9 10
##
## 1
## 1279
## int [1:10, 1] 1 2 3 4 5 6 7 8 9 10
## [,1]
## [1,] 1
## [2,] 2
## [3,] 3
## [4,] 4
## [5,] 5
## [6,] 6
##
##
## Number of unique outcome types: 10
##
## Moving to assess the: 10 rows of outcomes
##
##
## Mean: 0.995439 Variance: 19.51468jb96_3Play <- assessNPlay(keyList=jb96UniqueList, nPlay=3L)## List of 3
## $ : int [1:1000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1000] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1279
## int [1:1000, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3]
## [1,] 1 1 1
## [2,] 1 1 2
## [3,] 1 1 3
## [4,] 1 1 4
## [5,] 1 1 5
## [6,] 1 1 6
##
##
## Number of unique outcome types: 114
##
## Moving to assess the: 114 rows of outcomes
## num [1:1279, 1:3, 1:6] 0 0 0 0 0 ...
## num [1:1279, 1:6] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1279] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##
##
## Mean: 0.995439 Variance: 70.34236jb96_5Play <- assessNPlay(keyList=jb96UniqueList, nPlay=5L)## List of 5
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1279
## int [1:100000, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 406
##
## Moving to assess the: 406 rows of outcomes
## num [1:1279, 1:45] 0 0 0 0 0.000157 ...
## num [1:1279] 0 0 0 0 0.00157 ...
## [1] 100
## num [1:1279, 1:280] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1279] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1279, 1:240] 0 0 0 0 0 ...
## num [1:1279] 0 0 0 0 0 ...
## [1] 300
## num [1:1279, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1279] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
##
##
## Mean: 0.995439 Variance: 136.9012bp85_1Play <- assessNPlay(keyList=bp85UniqueList, nPlay=1L)## List of 1
## $ : int [1:12] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1647
## int [1:12, 1] 1 2 3 4 5 6 7 8 9 10 ...
## [,1]
## [1,] 1
## [2,] 2
## [3,] 3
## [4,] 4
## [5,] 5
## [6,] 6
##
##
## Number of unique outcome types: 12
##
## Moving to assess the: 12 rows of outcomes
##
##
## Mean: 0.9916597 Variance: 20.90408bp85_3Play <- assessNPlay(keyList=bp85UniqueList, nPlay=3L)## List of 3
## $ : int [1:1728] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1728] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1728] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1647
## int [1:1728, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3]
## [1,] 1 1 1
## [2,] 1 1 2
## [3,] 1 1 3
## [4,] 1 1 4
## [5,] 1 1 5
## [6,] 1 1 6
##
##
## Number of unique outcome types: 198
##
## Moving to assess the: 198 rows of outcomes
## num [1:1647, 1:3, 1:9] 0 0 0 0 0 ...
## num [1:1647, 1:9] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##
##
## Mean: 0.9916597 Variance: 75.4324bp85_5Play <- assessNPlay(keyList=bp85UniqueList, nPlay=5L)## List of 5
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1647
## int [1:248832, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 722
##
## Moving to assess the: 722 rows of outcomes
## num [1:1647, 1:1230] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 ...
## [1] 100
## num [1:1647, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1647, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
## num [1:1647, 1:420] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
## num [1:1647, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
## num [1:1647, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
## num [1:1647, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
##
##
## Mean: 0.9916597 Variance: 146.9209bpd96_1Play <- assessNPlay(keyList=bpd96UniqueList, nPlay=1L)## List of 1
## $ : int [1:9] 1 2 3 4 5 6 7 8 9
##
## 1
## 851
## int [1:9, 1] 1 2 3 4 5 6 7 8 9
## [,1]
## [1,] 1
## [2,] 2
## [3,] 3
## [4,] 4
## [5,] 5
## [6,] 6
##
##
## Number of unique outcome types: 9
##
## Moving to assess the: 9 rows of outcomes
##
##
## Mean: 0.9964171 Variance: 32.13404bpd96_3Play <- assessNPlay(keyList=bpd96UniqueList, nPlay=3L)## List of 3
## $ : int [1:729] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:729] 1 1 1 1 1 1 1 1 1 2 ...
## $ : int [1:729] 1 2 3 4 5 6 7 8 9 1 ...
##
## 1
## 851
## int [1:729, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3]
## [1,] 1 1 1
## [2,] 1 1 2
## [3,] 1 1 3
## [4,] 1 1 4
## [5,] 1 1 5
## [6,] 1 1 6
##
##
## Number of unique outcome types: 115
##
## Moving to assess the: 115 rows of outcomes
## num [1:851, 1:3, 1:6] 0 0 0 0 0 ...
## num [1:851, 1:6] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:851] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##
##
## Mean: 0.9964171 Variance: 118.5129bpd96_5Play <- assessNPlay(keyList=bpd96UniqueList, nPlay=5L)## List of 5
## $ : int [1:59049] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:59049] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:59049] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:59049] 1 1 1 1 1 1 1 1 1 2 ...
## $ : int [1:59049] 1 2 3 4 5 6 7 8 9 1 ...
##
## 1
## 851
## int [1:59049, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 511
##
## Moving to assess the: 511 rows of outcomes
## num [1:851, 1:200] 0.00 0.00 0.00 0.00 1.29e-06 ...
## num [1:851] 0.0 0.0 0.0 0.0 4.3e-05 ...
## [1] 100
## num [1:851, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:851] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:851, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:851] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
## num [1:851, 1:40] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:851] 0 0 0 0 0 ...
## [1] 400
## num [1:851, 1:10] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:851] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
##
##
## Mean: 0.9964171 Variance: 234.3727ddb96_1Play <- assessNPlay(keyList=ddb96UniqueList, nPlay=1L)## List of 1
## $ : int [1:11] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1260
## int [1:11, 1] 1 2 3 4 5 6 7 8 9 10 ...
## [,1]
## [1,] 1
## [2,] 2
## [3,] 3
## [4,] 4
## [5,] 5
## [6,] 6
##
##
## Number of unique outcome types: 11
##
## Moving to assess the: 11 rows of outcomes
##
##
## Mean: 0.9898078 Variance: 41.98498ddb96_3Play <- assessNPlay(keyList=ddb96UniqueList, nPlay=3L)## List of 3
## $ : int [1:1331] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1331] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1331] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1260
## int [1:1331, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3]
## [1,] 1 1 1
## [2,] 1 1 2
## [3,] 1 1 3
## [4,] 1 1 4
## [5,] 1 1 5
## [6,] 1 1 6
##
##
## Number of unique outcome types: 200
##
## Moving to assess the: 200 rows of outcomes
## num [1:1260, 1:3, 1:3] 0 0 0 0 0 ...
## num [1:1260, 1:3] 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 ...
## [1] 100
## num [1:1260, 1:3, 1] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260, 1] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##
##
## Mean: 0.9898078 Variance: 154.8091ddb96_5Play <- assessNPlay(keyList=ddb96UniqueList, nPlay=5L)## List of 5
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1260
## int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 1041
##
## Moving to assess the: 1041 rows of outcomes
## num [1:1260, 1:200] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## num [1:1260, 1:240] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1260, 1:10] 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 ...
## [1] 300
## num [1:1260, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
## num [1:1260, 1:145] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
## num [1:1260, 1:180] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
## num [1:1260, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
## num [1:1260, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
## num [1:1260, 1:30] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 900
## num [1:1260, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
##
##
## Mean: 0.9898078 Variance: 306.1054tdb96_1Play <- assessNPlay(keyList=tdb96UniqueList, nPlay=1L)## List of 1
## $ : int [1:11] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 945
## int [1:11, 1] 1 2 3 4 5 6 7 8 9 10 ...
## [,1]
## [1,] 1
## [2,] 2
## [3,] 3
## [4,] 4
## [5,] 5
## [6,] 6
##
##
## Number of unique outcome types: 11
##
## Moving to assess the: 11 rows of outcomes
##
##
## Mean: 0.98154 Variance: 100.1148tdb96_3Play <- assessNPlay(keyList=tdb96UniqueList, nPlay=3L)## List of 3
## $ : int [1:1331] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1331] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1331] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 945
## int [1:1331, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3]
## [1,] 1 1 1
## [2,] 1 1 2
## [3,] 1 1 3
## [4,] 1 1 4
## [5,] 1 1 5
## [6,] 1 1 6
##
##
## Number of unique outcome types: 206
##
## Moving to assess the: 206 rows of outcomes
## num [1:945, 1:3, 1:3] 0 0 0 0 1 0 0 0 0 0 ...
## num [1:945, 1:3] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## num [1:945, 1:3, 1:3] 1 0.255 0 0 0 ...
## num [1:945, 1:3] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##
##
## Mean: 0.98154 Variance: 364.4089tdb96_5Play <- assessNPlay(keyList=tdb96UniqueList, nPlay=5L)## List of 5
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 945
## int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 1064
##
## Moving to assess the: 1064 rows of outcomes
## num [1:945, 1:220] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## num [1:945, 1:390] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:945, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
## num [1:945, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 ...
## [1] 400
## num [1:945, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
## num [1:945, 1:290] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 ...
## [1] 600
## num [1:945, 1:200] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
## num [1:945, 1:180] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
## num [1:945, 1:115] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0.0158 0 ...
## [1] 900
## num [1:945, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
##
##
## Mean: 0.98154 Variance: 714.1226The 10-play variant no longer needs to be cached since the vectorized solution for driving 5-play to 10-play runs extremely quickly (later reverted to caching for the same reason as the above):
# Run as 10-play for JB 96, BP 85, BPD 96, DDB 96, and TDB 96
jb96_10Play <- assessNPlay(keyList=jb96UniqueList, nPlay=10L)## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1279
## int [1:100000, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 406
##
## Moving to assess the: 406 rows of outcomes
## num [1:1279, 1:45] 0 0 0 0 0.000157 ...
## num [1:1279] 0 0 0 0 0.00157 ...
## [1] 100
## num [1:1279, 1:280] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1279] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1279, 1:240] 0 0 0 0 0 ...
## num [1:1279] 0 0 0 0 0 ...
## [1] 300
## num [1:1279, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1279] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
##
##
## Mean: 0.995439 Variance: 372.1217bp85_10Play <- assessNPlay(keyList=bp85UniqueList, nPlay=10L)## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1647
## int [1:248832, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 722
##
## Moving to assess the: 722 rows of outcomes
## num [1:1647, 1:1230] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 ...
## [1] 100
## num [1:1647, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1647, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
## num [1:1647, 1:420] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
## num [1:1647, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
## num [1:1647, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
## num [1:1647, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
##
##
## Mean: 0.9916597 Variance: 399.8432bpd96_10Play <- assessNPlay(keyList=bpd96UniqueList, nPlay=10L)## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
## $ : int [1:59049] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:59049] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:59049] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:59049] 1 1 1 1 1 1 1 1 1 2 ...
## $ : int [1:59049] 1 2 3 4 5 6 7 8 9 1 ...
##
## 1
## 851
## int [1:59049, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 511
##
## Moving to assess the: 511 rows of outcomes
## num [1:851, 1:200] 0.00 0.00 0.00 0.00 1.29e-06 ...
## num [1:851] 0.0 0.0 0.0 0.0 4.3e-05 ...
## [1] 100
## num [1:851, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:851] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:851, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:851] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
## num [1:851, 1:40] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:851] 0 0 0 0 0 ...
## [1] 400
## num [1:851, 1:10] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:851] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
##
##
## Mean: 0.9964171 Variance: 653.0019ddb96_10Play <- assessNPlay(keyList=ddb96UniqueList, nPlay=10L)## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1260
## int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 1041
##
## Moving to assess the: 1041 rows of outcomes
## num [1:1260, 1:200] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## num [1:1260, 1:240] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1260, 1:10] 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 ...
## [1] 300
## num [1:1260, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
## num [1:1260, 1:145] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
## num [1:1260, 1:180] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
## num [1:1260, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
## num [1:1260, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
## num [1:1260, 1:30] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 900
## num [1:1260, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
##
##
## Mean: 0.9898078 Variance: 852.662tdb96_10Play <- assessNPlay(keyList=tdb96UniqueList, nPlay=10L)## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 945
## int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 1064
##
## Moving to assess the: 1064 rows of outcomes
## num [1:945, 1:220] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## num [1:945, 1:390] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:945, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
## num [1:945, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 ...
## [1] 400
## num [1:945, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
## num [1:945, 1:290] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 ...
## [1] 600
## num [1:945, 1:200] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
## num [1:945, 1:180] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
## num [1:945, 1:115] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0.0158 0 ...
## [1] 900
## num [1:945, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
##
##
## Mean: 0.98154 Variance: 1962.117Next, 2,000 simulations are run for up to 16,000 hands, with the percentiles assessed:
sim_NPlay <- function(keyFrame, useName, nPlay, nHands, nSims,
genCumMin=FALSE, genFullMin=FALSE, smpFullMin=100, runSTP=FALSE
) {
# Extract outcomes and associated odds from the N-play list
oddsNPlay <- round(100 * keyFrame$wts, 0)
resNPlay <- keyFrame$nOutcome
# Validate that the rouding of odds has not adversely impacted mean/variance
meanNPlay <- sum(oddsNPlay * resNPlay) / sum(oddsNPlay)
varNPlay <- sum(oddsNPlay * resNPlay^2) / sum(oddsNPlay) - meanNPlay^2
cat("\nMean base return per hand:", 1+meanNPlay/nPlay, "with total variance:", varNPlay)
# Take an appropriately sized sample from the resNPlay
holdNPlay <- base::sample(rep(resNPlay, times=oddsNPlay),
nSims*nHands, replace=TRUE
)
# Make the STP data (if appropriate)
if (isTRUE(runSTP)) {
vecSTP <- c(rep(1, 1400), rep(2, 17), rep(3, 33), rep(4, 16),
rep(5, 24), rep(8, 6), rep(10, 4)
)
multSTP <- base::sample(vecSTP, nSims*nHands, replace=TRUE)
# Apply the appropriate multiplier (applies only to winners, not bets)
holdNPlay <- (holdNPlay + nPlay) * multSTP - nPlay
# Subtract the extra bets (costs .2 per hand over nPlay total)
holdNPlay <- holdNPlay - .2 * nPlay
}
# Convert to the overall outcomes (each column is a simulation)
sumsNPlay <- colSums(matrix(holdNPlay, ncol=nSims))
if (isTRUE(genCumMin) | isTRUE(genFullMin)) {
cumSumNPlay <- apply(matrix(holdNPlay, ncol=nSims), 2, FUN=cumsum)
if (isTRUE(genCumMin)) { cumminNPlay <- apply(cumSumNPlay , 2, FUN=min) }
if (isTRUE(genFullMin)) {
fullminNPlay <- apply(cumSumNPlay, 2, FUN=cummin)
rownames(fullminNPlay) <- 1:nrow(fullminNPlay)
smlminNPlay <- fullminNPlay[seq(smpFullMin, nrow(fullminNPlay), by=smpFullMin), ]
}
}
# Report on the overall mean and variance/standard deviation
meanOverall <- mean(sumsNPlay) / (nHands * if(isTRUE(runSTP)) { 1.2 } else { 1.0 } )
varOverall <- var(sumsNPlay)
sdOverall <- sd(sumsNPlay)
cat("\nMean return per hand:",
paste0(round(100 * (1 + meanOverall/nPlay), 3), "%"),
"with total variance (sd as % of total bet):",
prettyNum(round(varOverall, 0), big.mark=","), "(",
paste0(round(100*sdOverall/(nHands * if(isTRUE(runSTP)) { 1.2 } else { 1.0 } )/nPlay, 2), "%"),
")\n"
)
print(round(quantile(sumsNPlay/(nHands * if(isTRUE(runSTP)) { 1.2 } else { 1.0 } )/nPlay,
c(0.01, 0.05, 0.10, 0.25, 0.5, 0.75, 0.90, 0.95, 0.99)
)
, 4)
)
# Report on the percentage distributions
par(mfrow=c(1, 2))
hist(sumsNPlay/(nHands * if(isTRUE(runSTP)) { 1.2 } else { 1.0 } )/nPlay, col="light blue",
main=paste0("% Ret: ", nPlay, "-play (", nHands, " ", useName," deals)"), xlab="% Return"
)
plot(x=(1:nSims)/nSims,
y=sort(sumsNPlay/(nHands * if(isTRUE(runSTP)) { 1.2 } else { 1.0 } )/nPlay),
pch=19, col="navy blue",
main=paste0("% Ret: ", nPlay, "-play (", nHands, " ", useName," deals)"),
xlab="Percentile", ylab="% Returns"
)
abline(h=0, v=0.5, lty=2)
par(mfrow=c(1, 1))
if (isTRUE(genCumMin) & isTRUE(genFullMin)) {
list(sumsNPlay=sumsNPlay, cumminNPlay=cumminNPlay, fullminNPlay=smlminNPlay)
} else if (isTRUE(genCumMin) & !isTRUE(genFullMin)) {
list(sumsNPlay=sumsNPlay, cumminNPlay=cumminNPlay)
} else if (!isTRUE(genCumMin) & isTRUE(genFullMin)) {
list(sumsNPlay=sumsNPlay, fullminNPlay=smlminNPlay)
} else {
sumsNPlay
}
}The simulations run reasonably quickly individually, but take enough time in aggregate to merit caching:
# Run for 10/5-play with 2,000 simulations of 16,000 hands
set.seed(1612200748)
jb96_10Sim <- sim_NPlay(keyFrame=jb96_10Play$out10Play, useName="JB 96",
nPlay=10, nHands=16000, nSim=2000
)##
## Mean return per hand: 0.9954273 with total variance: 371.8727
## Mean return per hand: 99.616% with total variance (sd as % of total bet): 6,032,571 ( 1.54% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0322 -0.0251 -0.0212 -0.0140 -0.0058 0.0044 0.0146 0.0222 0.0477
set.seed(1612210738)
jb96_5Sim <- sim_NPlay(keyFrame=jb96_5Play$dfOutcome, useName="JB 96",
nPlay=5, nHands=16000, nSim=2000
)##
## Mean return per hand: 0.9954371 with total variance: 136.8871
## Mean return per hand: 99.563% with total variance (sd as % of total bet): 2,319,842 ( 1.9% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0392 -0.0310 -0.0257 -0.0177 -0.0065 0.0056 0.0200 0.0306 0.0542
set.seed(1612201348)
bp85_10Sim <- sim_NPlay(keyFrame=bp85_10Play$out10Play, useName="BP 85",
nPlay=10, nHands=16000, nSim=2000
)##
## Mean return per hand: 0.9916439 with total variance: 399.5
## Mean return per hand: 99.174% with total variance (sd as % of total bet): 6,170,846 ( 1.55% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0364 -0.0303 -0.0263 -0.0186 -0.0096 -0.0001 0.0106 0.0188 0.0454
set.seed(1612211338)
bp85_5Sim <- sim_NPlay(keyFrame=bp85_5Play$dfOutcome, useName="BP 85",
nPlay=5, nHands=16000, nSim=2000
)##
## Mean return per hand: 0.9916568 with total variance: 146.9033
## Mean return per hand: 99.13% with total variance (sd as % of total bet): 2,500,141 ( 1.98% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0447 -0.0359 -0.0311 -0.0228 -0.0108 0.0023 0.0174 0.0269 0.0479
set.seed(2016122008)
bpd96_10Sim <- sim_NPlay(keyFrame=bpd96_10Play$out10Play, useName="BPD 96",
nPlay=10, nHands=16000, nSim=2000
)##
## Mean return per hand: 0.996406 with total variance: 652.7752
## Mean return per hand: 99.563% with total variance (sd as % of total bet): 10,255,554 ( 2% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0477 -0.0361 -0.0291 -0.0175 -0.0054 0.0080 0.0203 0.0292 0.0498
set.seed(2016122108)
bpd96_5Sim <- sim_NPlay(keyFrame=bpd96_5Play$dfOutcome, useName="BPD 96",
nPlay=5, nHands=16000, nSim=2000
)##
## Mean return per hand: 0.9964151 with total variance: 234.3575
## Mean return per hand: 99.652% with total variance (sd as % of total bet): 3,584,023 ( 2.37% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0517 -0.0405 -0.0327 -0.0203 -0.0045 0.0116 0.0272 0.0374 0.0593
set.seed(1220160749)
ddb96_10Sim <- sim_NPlay(keyFrame=ddb96_10Play$out10Play, useName="DDB 96",
nPlay=10, nHands=16000, nSim=2000
)##
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.896% with total variance (sd as % of total bet): 12,411,898 ( 2.2% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0578 -0.0449 -0.0382 -0.0269 -0.0116 0.0031 0.0173 0.0272 0.0446
set.seed(1221160739)
ddb96_5Sim <- sim_NPlay(keyFrame=ddb96_5Play$dfOutcome, useName="DDB 96",
nPlay=5, nHands=16000, nSim=2000
)##
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 98.942% with total variance (sd as % of total bet): 4,671,484 ( 2.7% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0655 -0.0523 -0.0443 -0.0294 -0.0123 0.0069 0.0243 0.0352 0.0626
set.seed(1220201608)
tdb96_10Sim <- sim_NPlay(keyFrame=tdb96_10Play$out10Play, useName="TDB 96",
nPlay=10, nHands=16000, nSim=2000
)##
## Mean return per hand: 0.9815219 with total variance: 1961.747
## Mean return per hand: 98.154% with total variance (sd as % of total bet): 31,748,125 ( 3.52% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0905 -0.0723 -0.0619 -0.0427 -0.0207 0.0031 0.0276 0.0436 0.0792
set.seed(1221201608)
tdb96_5Sim <- sim_NPlay(keyFrame=tdb96_5Play$dfOutcome, useName="TDB 96",
nPlay=5, nHands=16000, nSim=2000
)##
## Mean return per hand: 0.9815355 with total variance: 714.0964
## Mean return per hand: 98.241% with total variance (sd as % of total bet): 11,199,067 ( 4.18% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1028 -0.0822 -0.0686 -0.0472 -0.0208 0.0097 0.0362 0.0547 0.0883
A second attempt is made to further vectorize the n-play process, with results compared to the previous results:
# Function to create the 1-play data
get_uq1Play <- function(keyList) {
# Get the basic parameters
uq_1PlayRes <- keyList$mapOuts
uqCol <- ncol(keyList$uqCards)
cWeight <- keyList$uqCards[, uqCol]
uqHands <- keyList$uqCards[, -uqCol]
# Convert uqHands to percentage outcomes by hand
uq_1Play <- diag(1/rowSums(uqHands)) %*% uqHands
str(uq_1Play)
table(rowSums(uq_1Play))
list(uq_Play=uq_1Play, uq_Res=uq_1PlayRes, cWeight=cWeight)
}
# Get the 1-play data for JB 96, BP 85, and TDB 96
startTime <- proc.time()
jb96_uq001 <- get_uq1Play(keyList=jb96UniqueList)## num [1:1279, 1:10] 0 0 0 0 0.702 ...
## - attr(*, "dimnames")=List of 2
## ..$ : NULL
## ..$ : chr [1:10] "" "" "" "" ...str(jb96_uq001)## List of 3
## $ uq_Play: num [1:1279, 1:10] 0 0 0 0 0.702 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : NULL
## .. ..$ : chr [1:10] "" "" "" "" ...
## $ uq_Res : num [1:10] -1 799 49 8 5 3 2 1 0 24
## $ cWeight: Named num [1:1279] 624 3744 54912 123552 96 ...
## ..- attr(*, "names")= chr [1:1279] "1" "2" "3" "4" ...bp85_uq001 <- get_uq1Play(keyList=bp85UniqueList)## num [1:1647, 1:12] 0 0 0 0 0 ...
## - attr(*, "dimnames")=List of 2
## ..$ : NULL
## ..$ : chr [1:12] "" "" "" "" ...str(bp85_uq001)## List of 3
## $ uq_Play: num [1:1647, 1:12] 0 0 0 0 0 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : NULL
## .. ..$ : chr [1:12] "" "" "" "" ...
## $ uq_Res : num [1:12] -1 799 49 7 4 3 2 1 0 79 ...
## $ cWeight: Named num [1:1647] 48 144 432 3744 4224 ...
## ..- attr(*, "names")= chr [1:1647] "1" "2" "3" "4" ...tdb96_uq001 <- get_uq1Play(keyList=tdb96UniqueList)## num [1:945, 1:11] 0 0 0 0 0 0 0 0 0 0 ...
## - attr(*, "dimnames")=List of 2
## ..$ : NULL
## ..$ : chr [1:11] "" "" "" "" ...str(tdb96_uq001)## List of 3
## $ uq_Play: num [1:945, 1:11] 0 0 0 0 0 0 0 0 0 0 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : NULL
## .. ..$ : chr [1:11] "" "" "" "" ...
## $ uq_Res : num [1:11] -1 799 49 8 5 3 1 0 159 399 ...
## $ cWeight: Named num [1:945] 16 36 36 108 468 ...
## ..- attr(*, "names")= chr [1:945] "1" "2" "3" "4" ...proc.time() - startTime## user system elapsed
## 0.07 0.02 0.09# Function to cross-product n-play and m-play
create_mnPlay <- function(keyN, keyM) {
aTest <- matrix(data=0, nrow=nrow(keyN$uq_Play),
ncol=ncol(keyM$uq_Play)*ncol(keyN$uq_Play)
)
# Matrix multiply by "flavor" (unique rows)
for (intCtr in 1:nrow(keyN$uq_Play)) {
aTest[intCtr, ] <- as.vector( outer( keyN$uq_Play[intCtr, ], keyM$uq_Play[intCtr, ] ) )
}
# Sum outcomes for matrix cross product (column values for aTest)
aScore <- as.vector(outer(keyN$uq_Res, keyM$uq_Res, FUN="+"))
# Find and sort the unique scores
uqRes <- sort(unique(aScore))
# Convert the full aTest in to unique hands with values by column
map_Play <- matrix(data=0L, nrow=ncol(aTest), ncol=length(uqRes))
map_Mtx <- matrix(data=c(1:length(aScore), match(aScore, uqRes)),
nrow=length(aScore)
)
map_Play[ map_Mtx ] <- 1L
uq_Play <- aTest %*% map_Play
list(uq_Play=uq_Play, uq_Res=uqRes, cWeight=keyN$cWeight)
}
# Take JB 96, BP 85, and TDB 96 and expand from 1-play to 2-5 play
startTime <- proc.time()
jb96_uq002 <- create_mnPlay(keyN=jb96_uq001, keyM=jb96_uq001)
jb96_uq003 <- create_mnPlay(keyN=jb96_uq002, keyM=jb96_uq001)
jb96_uq004 <- create_mnPlay(keyN=jb96_uq003, keyM=jb96_uq001)
jb96_uq005 <- create_mnPlay(keyN=jb96_uq004, keyM=jb96_uq001)
proc.time() - startTime## user system elapsed
## 1.58 0.00 1.57bp85_uq002 <- create_mnPlay(keyN=bp85_uq001, keyM=bp85_uq001)
bp85_uq003 <- create_mnPlay(keyN=bp85_uq002, keyM=bp85_uq001)
bp85_uq004 <- create_mnPlay(keyN=bp85_uq003, keyM=bp85_uq001)
bp85_uq005 <- create_mnPlay(keyN=bp85_uq004, keyM=bp85_uq001)
proc.time() - startTime## user system elapsed
## 8.67 0.02 8.74tdb96_uq002 <- create_mnPlay(keyN=tdb96_uq001, keyM=tdb96_uq001)
tdb96_uq003 <- create_mnPlay(keyN=tdb96_uq002, keyM=tdb96_uq001)
tdb96_uq004 <- create_mnPlay(keyN=tdb96_uq003, keyM=tdb96_uq001)
tdb96_uq005 <- create_mnPlay(keyN=tdb96_uq004, keyM=tdb96_uq001)
proc.time() - startTime## user system elapsed
## 14.52 0.06 14.68The comparisons to former algorithms are cached to improve run times:
# Compare with the former algorithm (JB 96)
new_2dfOutcome <- data.frame(nOutcome=jb96_uq002$uq_Res,
wts=colSums(diag(jb96_uq002$cWeight) %*% jb96_uq002$uq_Play)
)
new_5dfOutcome <- data.frame(nOutcome=jb96_uq005$uq_Res,
wts=colSums(diag(jb96_uq005$cWeight) %*% jb96_uq005$uq_Play)
)
jb96_2Play <- assessNPlay(keyList=jb96UniqueList, nPlay=2L)## List of 2
## $ : int [1:100] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1279
## int [1:100, 1:2] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2]
## [1,] 1 1
## [2,] 1 2
## [3,] 1 3
## [4,] 1 4
## [5,] 1 5
## [6,] 1 6
##
##
## Number of unique outcome types: 42
##
## Moving to assess the: 42 rows of outcomes
##
##
## Mean: 0.995439 Variance: 42.96213jb96_5Play <- assessNPlay(keyList=jb96UniqueList, nPlay=5L)## List of 5
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1279
## int [1:100000, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 406
##
## Moving to assess the: 406 rows of outcomes
## num [1:1279, 1:45] 0 0 0 0 0.000157 ...
## num [1:1279] 0 0 0 0 0.00157 ...
## [1] 100
## num [1:1279, 1:280] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1279] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1279, 1:240] 0 0 0 0 0 ...
## num [1:1279] 0 0 0 0 0 ...
## [1] 300
## num [1:1279, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1279] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
##
##
## Mean: 0.995439 Variance: 136.9012all.equal(as.data.frame(jb96_2Play$dfOutcome[, -2]), new_2dfOutcome)## [1] TRUEall.equal(as.data.frame(jb96_5Play$dfOutcome[, -2]), new_5dfOutcome)## [1] TRUE# Compare with the former algorithm (BP 85)
new_2dfOutcome <- data.frame(nOutcome=bp85_uq002$uq_Res,
wts=colSums(diag(bp85_uq002$cWeight) %*% bp85_uq002$uq_Play)
)
new_5dfOutcome <- data.frame(nOutcome=bp85_uq005$uq_Res,
wts=colSums(diag(bp85_uq005$cWeight) %*% bp85_uq005$uq_Play)
)
bp85_2Play <- assessNPlay(keyList=bp85UniqueList, nPlay=2L)## List of 2
## $ : int [1:144] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:144] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1647
## int [1:144, 1:2] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2]
## [1,] 1 1
## [2,] 1 2
## [3,] 1 3
## [4,] 1 4
## [5,] 1 5
## [6,] 1 6
##
##
## Number of unique outcome types: 63
##
## Moving to assess the: 63 rows of outcomes
##
##
## Mean: 0.9916597 Variance: 46.04822bp85_5Play <- assessNPlay(keyList=bp85UniqueList, nPlay=5L)## List of 5
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1647
## int [1:248832, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 722
##
## Moving to assess the: 722 rows of outcomes
## num [1:1647, 1:1230] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 ...
## [1] 100
## num [1:1647, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1647, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
## num [1:1647, 1:420] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
## num [1:1647, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
## num [1:1647, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
## num [1:1647, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
##
##
## Mean: 0.9916597 Variance: 146.9209all.equal(as.data.frame(bp85_2Play$dfOutcome[, -2]), new_2dfOutcome)## [1] TRUEall.equal(as.data.frame(bp85_5Play$dfOutcome[, -2]), new_5dfOutcome)## [1] TRUE# Compare with the former algorithm (TDB 96)
new_2dfOutcome <- data.frame(nOutcome=tdb96_uq002$uq_Res,
wts=colSums(diag(tdb96_uq002$cWeight) %*% tdb96_uq002$uq_Play)
)
new_5dfOutcome <- data.frame(nOutcome=tdb96_uq005$uq_Res,
wts=colSums(diag(tdb96_uq005$cWeight) %*% tdb96_uq005$uq_Play)
)
tdb96_2Play <- assessNPlay(keyList=tdb96UniqueList, nPlay=2L)## List of 2
## $ : int [1:121] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:121] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 945
## int [1:121, 1:2] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2]
## [1,] 1 1
## [2,] 1 2
## [3,] 1 3
## [4,] 1 4
## [5,] 1 5
## [6,] 1 6
##
##
## Number of unique outcome types: 59
##
## Moving to assess the: 59 rows of outcomes
##
##
## Mean: 0.98154 Variance: 221.5844tdb96_5Play <- assessNPlay(keyList=tdb96UniqueList, nPlay=5L)## List of 5
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 945
## int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 1064
##
## Moving to assess the: 1064 rows of outcomes
## num [1:945, 1:220] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## num [1:945, 1:390] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:945, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
## num [1:945, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 ...
## [1] 400
## num [1:945, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
## num [1:945, 1:290] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 ...
## [1] 600
## num [1:945, 1:200] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
## num [1:945, 1:180] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
## num [1:945, 1:115] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0.0158 0 ...
## [1] 900
## num [1:945, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
##
##
## Mean: 0.98154 Variance: 714.1226all.equal(as.data.frame(tdb96_2Play$dfOutcome[, -2]), new_2dfOutcome)## [1] TRUEall.equal(as.data.frame(tdb96_5Play$dfOutcome[, -2]), new_5dfOutcome)## [1] TRUESo, the algorithm is a quicker way for expanding n-Play for reasonably small values of n (in the ~5 range) that preserve the “by outcome flavor” nature of the matrix.
Additionally, an algorithm is written to simplify away flavors that have a very low probability of occuring. For example, while it is theoretically possible to get 4 RF and 1 4 AwaK by holding a naked Ace, the probabilities of this occuring are vanishingly small. Because the matrices propagate forward, this very improbable outcome can then be combined with getting an A-5 SF, 4 2/3/4wA, and the like. The upshot is a lot of clutter in the matrices (straining memory and run-time) with no pragmatic impact on mean and variance.
As a default, an outcome (N-play flavor) is considered to be extremely unlikely if it would be observed less that once ever 25 billion dealt hands (10,000 cycles), though this tolerance can be adjusted. These probabilities can either be ignored (all other probabilities scaled up accordingly), placed in their own column with the appropriate mean, or allocated to existing columns nearest to them.
clean_NPlay <- function(nPlayInput, nTol=0.0001, reAlloc=TRUE, makeOwn=TRUE) {
# Anything with occurence less than nTol per choose(52, 5) will be excluded from the output
# If reAlloc==TRUE then all other elements are scaled up to get total back to choose(52, 5)
# If reAlloc==FALSE and makeOwn==TRUE, all exclusions are aggregated a single "new" column
# If reAlloc==FALSE and makeOwn==FALSE, all exclusions are re-assigned to the closest column
cWeight <- nPlayInput$cWeight
uq_Play <- nPlayInput$uq_Play
uq_Res <- nPlayInput$uq_Res
colWts <- colSums( cWeight * uq_Play )
tooSmall <- (colWts < nTol)
# Grab the contributions tomean and variance for tooSmall, !tooSmall, and all
fullSum <- sum(colWts * uq_Res)
lrgSum <- sum(colWts[!tooSmall] * uq_Res[!tooSmall])
smlSum <- sum(colWts[tooSmall] * uq_Res[tooSmall])
fullSum2 <- sum(colWts * uq_Res^2)
lrgSum2 <- sum(colWts[!tooSmall] * uq_Res[!tooSmall]^2)
smlSum2 <- sum(colWts[tooSmall] * uq_Res[tooSmall]^2)
cat("\n\nContributions to SUM:",
prettyNum(round(fullSum, 1), big.mark=","),
prettyNum(round(lrgSum, 1), big.mark=","),
paste0("(", round(100*lrgSum/fullSum, 2), "%)"),
prettyNum(round(smlSum, 1), big.mark=","),
paste0("(", round(100*smlSum/fullSum, 2), "%)")
)
cat("\nContributions to SUM-SQUARED:",
prettyNum(round(fullSum2, 0), big.mark=","),
prettyNum(round(lrgSum2, 0), big.mark=","),
paste0("(", round(100*lrgSum2/fullSum2, 2), "%)"),
prettyNum(round(smlSum2, 0), big.mark=","),
paste0("(", round(100*smlSum2/fullSum2, 2), "%)")
)
cat("\n\nMeans Assuming All, Large, Small:",
round(fullSum/sum(colWts), 6),
round(lrgSum/sum(colWts[!tooSmall]), 6),
round(smlSum/sum(colWts[tooSmall]), 6)
)
cat("\nVariances Assuming All, Large, Small:",
prettyNum(fullSum2/sum(colWts) - (fullSum/sum(colWts))^2, big.mark=","),
prettyNum(lrgSum2/sum(colWts[!tooSmall]) - (lrgSum/sum(colWts[!tooSmall]))^2, big.mark=","),
prettyNum(smlSum2/sum(colWts[tooSmall]) - (smlSum/sum(colWts[tooSmall]))^2, big.mark=","),
"\n"
)
if (isTRUE(reAlloc)) {
cleanNList <- list(uq_Play=(uq_Play[, !tooSmall] / rowSums(uq_Play[, !tooSmall])),
uq_Res=uq_Res[!tooSmall],
cWeight=cWeight
)
} else if (isTRUE(makeOwn)) {
uqOwnMean <- round(smlSum/sum(colWts[tooSmall]), 4)
uqOwnOdds <- 1 - rowSums(uq_Play[, !tooSmall])
cleanNList <- list(uq_Play=cbind(uq_Play[, !tooSmall], uqOwnOdds),
uq_Res=c(uq_Res[!tooSmall], uqOwnMean),
cWeight=cWeight
)
} else {
stop("Still need to implement other return modes")
}
newCSum <- colSums(cleanNList$cWeight * cleanNList$uq_Play)
cat("\nMeans shifted from/to:",
round(fullSum/sum(colWts), 6),
round(sum(newCSum * cleanNList$uq_Res)/sum(newCSum), 6)
)
cat("\nE[X^2] shifted from/to:",
round(fullSum2/sum(colWts), 3),
round(sum(newCSum * cleanNList$uq_Res^2)/sum(newCSum), 3),
"\n\n"
)
cleanNList
}Several initial runs of the methodology are cached for run-time optimization:
# Expand BP 85 (carefully) to 10-play (using default re-allocations)
bp85_cl005 <- clean_NPlay(nPlayInput=bp85_uq005)##
##
## Contributions to SUM: -108,380.1 -108,381.2 (100%) 1.1 (0%)
## Contributions to SUM-SQUARED: 381,846,163 381,844,232 (100%) 1,931 (0%)
##
## Means Assuming All, Large, Small: -0.041701 -0.041702 1005.985
## Variances Assuming All, Large, Small: 146.9209 146.9202 761,942.2
##
## Means shifted from/to: -0.041701 -0.041702
## E[X^2] shifted from/to: 146.923 146.922bp85_uqcl006 <- create_mnPlay(keyN=bp85_cl005, keyM=bp85_uq001)
bp85_cl006 <- clean_NPlay(nPlayInput=bp85_uqcl006)##
##
## Contributions to SUM: -130,057.2 -130,059.3 (100%) 2.1 (0%)
## Contributions to SUM-SQUARED: 491,273,735 491,269,195 (100%) 4,540 (0%)
##
## Means Assuming All, Large, Small: -0.050042 -0.050043 1357.013
## Variances Assuming All, Large, Small: 189.0245 189.0228 1,072,699
##
## Means shifted from/to: -0.050042 -0.050043
## E[X^2] shifted from/to: 189.027 189.025bp85_uqcl007 <- create_mnPlay(keyN=bp85_cl006, keyM=bp85_uq001)
bp85_cl007 <- clean_NPlay(nPlayInput=bp85_uqcl007)##
##
## Contributions to SUM: -151,735.3 -151,738.8 (100%) 3.5 (0%)
## Contributions to SUM-SQUARED: 611,718,784 611,711,052 (100%) 7,732 (0%)
##
## Means Assuming All, Large, Small: -0.058383 -0.058384 1407.485
## Variances Assuming All, Large, Small: 235.3672 235.3642 1,129,266
##
## Means shifted from/to: -0.058383 -0.058384
## E[X^2] shifted from/to: 235.371 235.368bp85_uqcl008 <- create_mnPlay(keyN=bp85_cl007, keyM=bp85_uq001)
bp85_cl008 <- clean_NPlay(nPlayInput=bp85_uqcl008)##
##
## Contributions to SUM: -173,414.6 -173,419 (100%) 4.4 (0%)
## Contributions to SUM-SQUARED: 743,180,710 743,170,588 (100%) 10,122 (0%)
##
## Means Assuming All, Large, Small: -0.066725 -0.066726 1419.243
## Variances Assuming All, Large, Small: 285.9487 285.9448 1,276,972
##
## Means shifted from/to: -0.066725 -0.066726
## E[X^2] shifted from/to: 285.953 285.949bp85_uqcl009 <- create_mnPlay(keyN=bp85_cl008, keyM=bp85_uq001)
bp85_cl009 <- clean_NPlay(nPlayInput=bp85_uqcl009)##
##
## Contributions to SUM: -195,094.7 -195,101.6 (100%) 6.9 (0%)
## Contributions to SUM-SQUARED: 885,660,269 885,643,513 (100%) 16,755 (0%)
##
## Means Assuming All, Large, Small: -0.075066 -0.075069 1653.267
## Variances Assuming All, Large, Small: 340.7692 340.7628 1,262,329
##
## Means shifted from/to: -0.075066 -0.075069
## E[X^2] shifted from/to: 340.775 340.769bp85_uqcl010_reAlloc <- create_mnPlay(keyN=bp85_cl009, keyM=bp85_uq001)
bp85_cl010_reAlloc <- clean_NPlay(nPlayInput=bp85_uqcl010_reAlloc)##
##
## Contributions to SUM: -216,777.2 -216,785.4 (100%) 8.3 (0%)
## Contributions to SUM-SQUARED: 1,039,153,280 1,039,132,256 (100%) 21,025 (0%)
##
## Means Assuming All, Large, Small: -0.083409 -0.083412 1675.765
## Variances Assuming All, Large, Small: 399.8273 399.8192 1,453,131
##
## Means shifted from/to: -0.083409 -0.083412
## E[X^2] shifted from/to: 399.834 399.826# Expand BP 85 (carefully) to 10-play (using own means)
bp85_cl005 <- clean_NPlay(nPlayInput=bp85_uq005, reAlloc=FALSE, makeOwn=TRUE)##
##
## Contributions to SUM: -108,380.1 -108,381.2 (100%) 1.1 (0%)
## Contributions to SUM-SQUARED: 381,846,163 381,844,232 (100%) 1,931 (0%)
##
## Means Assuming All, Large, Small: -0.041701 -0.041702 1005.985
## Variances Assuming All, Large, Small: 146.9209 146.9202 761,942.2
##
## Means shifted from/to: -0.041701 -0.041701
## E[X^2] shifted from/to: 146.923 146.922bp85_uqcl006 <- create_mnPlay(keyN=bp85_cl005, keyM=bp85_uq001)
bp85_cl006 <- clean_NPlay(nPlayInput=bp85_uqcl006, reAlloc=FALSE, makeOwn=TRUE)##
##
## Contributions to SUM: -130,056.1 -130,058.4 (100%) 2.3 (0%)
## Contributions to SUM-SQUARED: 491,274,824 491,270,111 (100%) 4,713 (0%)
##
## Means Assuming All, Large, Small: -0.050042 -0.050042 1328.323
## Variances Assuming All, Large, Small: 189.025 189.0231 985,569.8
##
## Means shifted from/to: -0.050042 -0.050042
## E[X^2] shifted from/to: 189.027 189.027bp85_uqcl007 <- create_mnPlay(keyN=bp85_cl006, keyM=bp85_uq001)
bp85_cl007 <- clean_NPlay(nPlayInput=bp85_uqcl007, reAlloc=FALSE, makeOwn=TRUE)##
##
## Contributions to SUM: -151,732.2 -151,736 (100%) 3.9 (0%)
## Contributions to SUM-SQUARED: 611,722,693 611,714,472 (100%) 8,221 (0%)
##
## Means Assuming All, Large, Small: -0.058382 -0.058383 1383.576
## Variances Assuming All, Large, Small: 235.3687 235.3655 1,014,200
##
## Means shifted from/to: -0.058382 -0.058382
## E[X^2] shifted from/to: 235.372 235.371bp85_uqcl008 <- create_mnPlay(keyN=bp85_cl007, keyM=bp85_uq001)
bp85_cl008 <- clean_NPlay(nPlayInput=bp85_uqcl008, reAlloc=FALSE, makeOwn=TRUE)##
##
## Contributions to SUM: -173,408.2 -173,413.2 (100%) 5.1 (0%)
## Contributions to SUM-SQUARED: 743,189,461 743,178,357 (100%) 11,104 (0%)
##
## Means Assuming All, Large, Small: -0.066722 -0.066724 1407.355
## Variances Assuming All, Large, Small: 285.952 285.9478 1,108,593
##
## Means shifted from/to: -0.066722 -0.066722
## E[X^2] shifted from/to: 285.956 285.955bp85_uqcl009 <- create_mnPlay(keyN=bp85_cl008, keyM=bp85_uq001)
bp85_cl009 <- clean_NPlay(nPlayInput=bp85_uqcl009, reAlloc=FALSE, makeOwn=TRUE)##
##
## Contributions to SUM: -195,084.2 -195,092.3 (100%) 8.1 (0%)
## Contributions to SUM-SQUARED: 885,675,135 885,656,711 (100%) 18,424 (0%)
##
## Means Assuming All, Large, Small: -0.075062 -0.075066 1613.281
## Variances Assuming All, Large, Small: 340.775 340.7679 1,082,761
##
## Means shifted from/to: -0.075062 -0.075062
## E[X^2] shifted from/to: 340.781 340.779bp85_uqcl010_makeOwn <- create_mnPlay(keyN=bp85_cl009, keyM=bp85_uq001)
bp85_cl010_makeOwn <- clean_NPlay(nPlayInput=bp85_uqcl010_makeOwn,
reAlloc=FALSE, makeOwn=TRUE
)##
##
## Contributions to SUM: -216,760.2 -216,770.1 (100%) 9.9 (0%)
## Contributions to SUM-SQUARED: 1,039,179,419 1,039,155,803 (100%) 23,616 (0%)
##
## Means Assuming All, Large, Small: -0.083403 -0.083406 1644.14
## Variances Assuming All, Large, Small: 399.8374 399.8283 1,218,110
##
## Means shifted from/to: -0.083403 -0.083403
## E[X^2] shifted from/to: 399.844 399.842# Comparisons of results
bp85_cl010_reAlloc <- clean_NPlay(nPlayInput=bp85_uqcl010_reAlloc)##
##
## Contributions to SUM: -216,777.2 -216,785.4 (100%) 8.3 (0%)
## Contributions to SUM-SQUARED: 1,039,153,280 1,039,132,256 (100%) 21,025 (0%)
##
## Means Assuming All, Large, Small: -0.083409 -0.083412 1675.765
## Variances Assuming All, Large, Small: 399.8273 399.8192 1,453,131
##
## Means shifted from/to: -0.083409 -0.083412
## E[X^2] shifted from/to: 399.834 399.826bp85_cl010_makeOwn <- clean_NPlay(nPlayInput=bp85_uqcl010_makeOwn,
reAlloc=FALSE, makeOwn=TRUE
)##
##
## Contributions to SUM: -216,760.2 -216,770.1 (100%) 9.9 (0%)
## Contributions to SUM-SQUARED: 1,039,179,419 1,039,155,803 (100%) 23,616 (0%)
##
## Means Assuming All, Large, Small: -0.083403 -0.083406 1644.14
## Variances Assuming All, Large, Small: 399.8374 399.8283 1,218,110
##
## Means shifted from/to: -0.083403 -0.083403
## E[X^2] shifted from/to: 399.844 399.842useWeight <- bp85UniqueList$uqCards[, ncol(bp85UniqueList$uqCards)]
theoMean <- weighted.mean(bp85UniqueList$uqFrame$uqMean, w=useWeight)
theoDealVar <- var(rep(bp85List$tempSmallMax[1, ], times=cardWeight))
theoDrawVar <- mean(rep(bp85UniqueList$uqFrame$uqVar, times=useWeight))
cat("\n\n10-play BP 85 should have mean:", round(10*theoMean, 6), "with variance:",
10 * (10 * theoDealVar + theoDrawVar), "\n"
)##
##
## 10-play BP 85 should have mean: -0.083403 with variance: 399.8433At least for projecting BP 85 to 10-play, the “make own” methodology is extremely closely tied to theoretical outcomes.
The next step is to significantly optimize the core of the propagation algorithm so that it does not need to maintain so many zeroes. A simplified function is attempted to use “for” loops to sum columns (potentially much faster for larger matrices since there is no need to keep a large “multiplying” matrix):
# Function to cross-product n-play and m-play
forCreate_mnPlay <- function(keyN, keyM) {
# Sum outcomes for matrix cross product (column values for aTest)
aScore <- outer(keyN$uq_Res, keyM$uq_Res, FUN="+")
# Find and sort the unique scores
uqScores <- sort(unique(as.vector(aScore)))
# Test this using the for loop instead
uq_Play <- matrix(data=0, nrow=nrow(keyN$uq_Play), ncol=length(uqScores))
for (intCtr in seq_along(uqScores)) {
# Find elements to be cross-multiplied
multN <- row(aScore)[aScore == uqScores[intCtr]]
multM <- col(aScore)[aScore == uqScores[intCtr]]
uq_Play[, intCtr] <- rowSums(keyN$uq_Play[, multN, drop=FALSE] *
keyM$uq_Play[, multM, drop=FALSE]
)
}
list(uq_Play=uq_Play, uq_Res=uqScores, cWeight=keyN$cWeight)
}The algorithm is then attempted for expansions to 2-play through 5-play:
# Take JB 96, BP 85, and TDB 96 and expand from 1-play to 2/5 play
startTime <- proc.time()
jb96_uq002_for <- forCreate_mnPlay(keyN=jb96_uq001, keyM=jb96_uq001)
jb96_uq005_for <- forCreate_mnPlay(keyN=jb96_uq004, keyM=jb96_uq001)
proc.time() - startTime## user system elapsed
## 0.08 0.00 0.08startTime <- proc.time()
bp85_uq002_for <- forCreate_mnPlay(keyN=bp85_uq001, keyM=bp85_uq001)
bp85_uq005_for <- forCreate_mnPlay(keyN=bp85_uq004, keyM=bp85_uq001)
proc.time() - startTime## user system elapsed
## 0.2 0.0 0.2startTime <- proc.time()
tdb96_uq002_for <- forCreate_mnPlay(keyN=tdb96_uq001, keyM=tdb96_uq001)
tdb96_uq005_for <- forCreate_mnPlay(keyN=tdb96_uq004, keyM=tdb96_uq001)
proc.time() - startTime## user system elapsed
## 0.19 0.00 0.19# Compare with the former algorithm
all.equal(jb96_uq002, jb96_uq002_for)## [1] TRUEall.equal(jb96_uq005, jb96_uq005_for)## [1] TRUEall.equal(bp85_uq002, bp85_uq002_for)## [1] TRUEall.equal(bp85_uq005, bp85_uq005_for)## [1] TRUEall.equal(tdb96_uq002, tdb96_uq002_for)## [1] TRUEall.equal(tdb96_uq005, tdb96_uq005_for)## [1] TRUEThe algorithm is then again run for expansions to 10/15-play, with results cached for improved run times:
# Expansion to 10-play
startTime <- proc.time()
jb96_uq010 <- forCreate_mnPlay(keyN=jb96_uq005, keyM=jb96_uq005)
thisList <- jb96_uq010
nEX <- sum( colSums( thisList$cWeight * thisList$uq_Play ) *
thisList$uq_Res ) / sum(thisList$cWeight)
nEX2 <- sum( colSums( thisList$cWeight * thisList$uq_Play ) *
thisList$uq_Res^2 ) / sum(thisList$cWeight)
cat("\nJB 96 10-play has return:", round(nEX, 6), "and variance:", round(nEX2-nEX^2, 2))##
## JB 96 10-play has return: -0.04561 and variance: 372.12proc.time() - startTime## user system elapsed
## 10.93 2.18 13.28startTime <- proc.time()
bp85_uq010_cl <- forCreate_mnPlay(keyN=bp85_cl005, keyM=bp85_cl005)
thisList <- bp85_uq010_cl
nEX <- sum( colSums( thisList$cWeight * thisList$uq_Play ) *
thisList$uq_Res ) / sum(thisList$cWeight)
nEX2 <- sum( colSums( thisList$cWeight * thisList$uq_Play ) *
thisList$uq_Res^2 ) / sum(thisList$cWeight)
cat("\nBP 85 10-play has return:", round(nEX, 6), "and variance:", round(nEX2-nEX^2, 2))##
## BP 85 10-play has return: -0.083403 and variance: 399.84proc.time() - startTime## user system elapsed
## 5.74 1.76 7.66startTime <- proc.time()
tdb96_cl005 <- clean_NPlay(nPlayInput=tdb96_uq005)##
##
## Contributions to SUM: -239,884.5 -239,886 (100%) 1.5 (0%)
## Contributions to SUM-SQUARED: 1,855,998,103 1,855,995,526 (100%) 2,577 (0%)
##
## Means Assuming All, Large, Small: -0.0923 -0.092301 798.0552
## Variances Assuming All, Large, Small: 714.1226 714.1216 721,907.6
##
## Means shifted from/to: -0.0923 -0.092301
## E[X^2] shifted from/to: 714.131 714.13tdb96_uq010_cl <- forCreate_mnPlay(keyN=tdb96_cl005, keyM=tdb96_cl005)
thisList <- tdb96_uq010_cl
nEX <- sum( colSums( thisList$cWeight * thisList$uq_Play ) *
thisList$uq_Res ) / sum(thisList$cWeight)
nEX2 <- sum( colSums( thisList$cWeight * thisList$uq_Play ) *
thisList$uq_Res^2 ) / sum(thisList$cWeight)
cat("\nTDB 96 10-play has return:", round(nEX, 6), "and variance:", round(nEX2-nEX^2, 2))##
## TDB 96 10-play has return: -0.184602 and variance: 1962.11proc.time() - startTime## user system elapsed
## 14.23 3.82 18.26# Expansion to 15-play
startTime <- proc.time()
jb96_cl005 <- clean_NPlay(nPlayInput=jb96_uq005)##
##
## Contributions to SUM: -59,268.7 -59,269.5 (100%) 0.8 (0%)
## Contributions to SUM-SQUARED: 355,801,979 355,800,279 (100%) 1,700 (0%)
##
## Means Assuming All, Large, Small: -0.022805 -0.022805 1300.044
## Variances Assuming All, Large, Small: 136.9012 136.9005 1,086,441
##
## Means shifted from/to: -0.022805 -0.022805
## E[X^2] shifted from/to: 136.902 136.901jb96_cl010 <- clean_NPlay(nPlayInput=jb96_uq010)##
##
## Contributions to SUM: -118,537.4 -118,551.2 (100.01%) 13.7 (-0.01%)
## Contributions to SUM-SQUARED: 967,134,937 967,097,447 (100%) 37,490 (0%)
##
## Means Assuming All, Large, Small: -0.04561 -0.045615 1978.338
## Variances Assuming All, Large, Small: 372.1217 372.1073 1,484,668
##
## Means shifted from/to: -0.04561 -0.045614
## E[X^2] shifted from/to: 372.124 372.11jb96_uq015_cl <- forCreate_mnPlay(keyN=jb96_cl010, keyM=jb96_cl005)
thisList <- jb96_uq015_cl
nEX <- sum( colSums( thisList$cWeight * thisList$uq_Play ) *
thisList$uq_Res ) / sum(thisList$cWeight)
nEX2 <- sum( colSums( thisList$cWeight * thisList$uq_Play ) *
thisList$uq_Res^2 ) / sum(thisList$cWeight)
cat("\nJB 96 15-play has return:", round(nEX, 6), "and variance:", round(nEX2-nEX^2, 2))##
## JB 96 15-play has return: -0.068419 and variance: 705.65proc.time() - startTime## user system elapsed
## 10.72 2.73 13.70startTime <- proc.time()
bp85_cl010 <- clean_NPlay(nPlayInput=bp85_uq010_cl)##
##
## Contributions to SUM: -216,760.2 -216,773.4 (100.01%) 13.2 (-0.01%)
## Contributions to SUM-SQUARED: 1,039,192,798 1,039,159,064 (100%) 33,733 (0%)
##
## Means Assuming All, Large, Small: -0.083403 -0.083408 1765.973
## Variances Assuming All, Large, Small: 399.8425 399.8295 1,393,269
##
## Means shifted from/to: -0.083403 -0.083407
## E[X^2] shifted from/to: 399.849 399.837bp85_uq015_cl <- forCreate_mnPlay(keyN=bp85_cl010, keyM=bp85_cl005)
thisList <- bp85_uq015_cl
nEX <- sum( colSums( thisList$cWeight * thisList$uq_Play ) *
thisList$uq_Res ) / sum(thisList$cWeight)
nEX2 <- sum( colSums( thisList$cWeight * thisList$uq_Play ) *
thisList$uq_Res^2 ) / sum(thisList$cWeight)
cat("\nBP 85 15-play has return:", round(nEX, 6), "and variance:", round(nEX2-nEX^2, 2))##
## BP 85 15-play has return: -0.125109 and variance: 758.75proc.time() - startTime## user system elapsed
## 18.11 4.51 23.18startTime <- proc.time()
tdb96_cl010 <- clean_NPlay(nPlayInput=tdb96_uq010_cl)##
##
## Contributions to SUM: -479,772.1 -479,789 (100%) 17 (0%)
## Contributions to SUM-SQUARED: 5,099,546,473 5,099,502,905 (100%) 43,568 (0%)
##
## Means Assuming All, Large, Small: -0.184602 -0.184608 1803.959
## Variances Assuming All, Large, Small: 1,962.115 1,962.098 1,378,680
##
## Means shifted from/to: -0.184602 -0.184608
## E[X^2] shifted from/to: 1962.149 1962.132tdb96_uq015_cl <- forCreate_mnPlay(keyN=tdb96_cl010, keyM=tdb96_cl005)
thisList <- tdb96_uq015_cl
nEX <- sum( colSums( thisList$cWeight * thisList$uq_Play ) *
thisList$uq_Res ) / sum(thisList$cWeight)
nEX2 <- sum( colSums( thisList$cWeight * thisList$uq_Play ) *
thisList$uq_Res^2 ) / sum(thisList$cWeight)
cat("\nTDB 96 15-play has return:", round(nEX, 6), "and variance:", round(nEX2-nEX^2, 2))##
## TDB 96 15-play has return: -0.276908 and variance: 3743.96proc.time() - startTime## user system elapsed
## 52.67 13.29 67.61# Theoretical expectations for 10-play and 15-play
useWeight <- jb96UniqueList$uqCards[, ncol(jb96UniqueList$uqCards)]
theoMean <- weighted.mean(jb96UniqueList$uqFrame$uqMean, w=useWeight)
theoDealVar <- var(rep(jb96List$tempSmallMax[1, ], times=cardWeight))
theoDrawVar <- mean(rep(jb96UniqueList$uqFrame$uqVar, times=useWeight))
cat("\n\n10-play JB 96 should have mean:", round(10*theoMean, 6), "with variance:",
10 * (10 * theoDealVar + theoDrawVar), "\n"
)##
##
## 10-play JB 96 should have mean: -0.04561 with variance: 372.1218cat("\n\n15-play JB 96 should have mean:", round(15*theoMean, 6), "with variance:",
15 * (15 * theoDealVar + theoDrawVar), "\n"
)##
##
## 15-play JB 96 should have mean: -0.068414 with variance: 705.6619useWeight <- bp85UniqueList$uqCards[, ncol(bp85UniqueList$uqCards)]
theoMean <- weighted.mean(bp85UniqueList$uqFrame$uqMean, w=useWeight)
theoDealVar <- var(rep(bp85List$tempSmallMax[1, ], times=cardWeight))
theoDrawVar <- mean(rep(bp85UniqueList$uqFrame$uqVar, times=useWeight))
cat("\n\n10-play BP 85 should have mean:", round(10*theoMean, 6), "with variance:",
10 * (10 * theoDealVar + theoDrawVar), "\n"
)##
##
## 10-play BP 85 should have mean: -0.083403 with variance: 399.8433cat("\n\n15-play BP 85 should have mean:", round(15*theoMean, 6), "with variance:",
15 * (15 * theoDealVar + theoDrawVar), "\n"
)##
##
## 15-play BP 85 should have mean: -0.125104 with variance: 758.767useWeight <- tdb96UniqueList$uqCards[, ncol(tdb96UniqueList$uqCards)]
theoMean <- weighted.mean(tdb96UniqueList$uqFrame$uqMean, w=useWeight)
theoDealVar <- var(rep(tdb96List$tempSmallMax[1, ], times=cardWeight))
theoDrawVar <- mean(rep(tdb96UniqueList$uqFrame$uqVar, times=useWeight))
cat("\n\n10-play TDB 96 should have mean:", round(10*theoMean, 6), "with variance:",
10 * (10 * theoDealVar + theoDrawVar), "\n"
)##
##
## 10-play TDB 96 should have mean: -0.1846 with variance: 1962.117cat("\n\n15-play TDB 96 should have mean:", round(15*theoMean, 6), "with variance:",
15 * (15 * theoDealVar + theoDrawVar), "\n"
)##
##
## 15-play TDB 96 should have mean: -0.276901 with variance: 3743.984One other attempt is made to run the matrix multiplications, this time going row-by-row rather than column-by-column:
# Function to cross-product n-play and m-play
forRowCreate_mnPlay <- function(keyN, keyM) {
# Sum outcomes for matrix cross product (column values for aTest)
aScore <- as.vector(outer(keyN$uq_Res, keyM$uq_Res, FUN="+"))
# Find and sort the unique scores
uqScores <- sort(unique(as.vector(aScore)))
# Create the unique play matrix
uq_Play <- matrix(data=0, nrow=nrow(keyN$uq_Play), ncol=length(uqScores))
# Get the multipliers
mapScores <- match(aScore, uqScores)
# Test this using the for loop instead
for (intCtr in seq_len(nrow(keyN$uq_Play))) {
# Get the outer product of the key row
tmpOuter <- as.vector(outer(keyN$uq_Play[intCtr, ], keyM$uq_Play[intCtr, ], FUN="*"))
tmpVector <- data.frame(colNum=mapScores, pctVal=tmpOuter) %>%
group_by(colNum) %>%
summarize(totPct=sum(pctVal))
uq_Play[intCtr, ] <- as.data.frame(tmpVector)[, 2]
if (intCtr %% 100 == 0) { cat("\nProcessed row", intCtr) }
}
list(uq_Play=uq_Play, uq_Res=uqScores, cWeight=keyN$cWeight)
}
# Compare timing
startTime <- proc.time()
tdb96_cl005 <- clean_NPlay(nPlayInput=tdb96_uq005)##
##
## Contributions to SUM: -239,884.5 -239,886 (100%) 1.5 (0%)
## Contributions to SUM-SQUARED: 1,855,998,103 1,855,995,526 (100%) 2,577 (0%)
##
## Means Assuming All, Large, Small: -0.0923 -0.092301 798.0552
## Variances Assuming All, Large, Small: 714.1226 714.1216 721,907.6
##
## Means shifted from/to: -0.0923 -0.092301
## E[X^2] shifted from/to: 714.131 714.13tdb96_uq010_cl <- forRowCreate_mnPlay(keyN=tdb96_cl005, keyM=tdb96_cl005)##
## Processed row 100
## Processed row 200
## Processed row 300
## Processed row 400
## Processed row 500
## Processed row 600
## Processed row 700
## Processed row 800
## Processed row 900thisList <- tdb96_uq010_cl
nEX <- sum( colSums( thisList$cWeight * thisList$uq_Play ) *
thisList$uq_Res ) / sum(thisList$cWeight)
nEX2 <- sum( colSums( thisList$cWeight * thisList$uq_Play ) *
thisList$uq_Res^2 ) / sum(thisList$cWeight)
cat("\nTDB 96 10-play has return:", round(nEX, 6), "and variance:", round(nEX2-nEX^2, 2))##
## TDB 96 10-play has return: -0.184602 and variance: 1962.11proc.time() - startTime## user system elapsed
## 14.05 0.00 14.14startTime <- proc.time()
tdb96_cl005 <- clean_NPlay(nPlayInput=tdb96_uq005)##
##
## Contributions to SUM: -239,884.5 -239,886 (100%) 1.5 (0%)
## Contributions to SUM-SQUARED: 1,855,998,103 1,855,995,526 (100%) 2,577 (0%)
##
## Means Assuming All, Large, Small: -0.0923 -0.092301 798.0552
## Variances Assuming All, Large, Small: 714.1226 714.1216 721,907.6
##
## Means shifted from/to: -0.0923 -0.092301
## E[X^2] shifted from/to: 714.131 714.13tdb96_uq010_cl <- forCreate_mnPlay(keyN=tdb96_cl005, keyM=tdb96_cl005)
thisList <- tdb96_uq010_cl
nEX <- sum( colSums( thisList$cWeight * thisList$uq_Play ) *
thisList$uq_Res ) / sum(thisList$cWeight)
nEX2 <- sum( colSums( thisList$cWeight * thisList$uq_Play ) *
thisList$uq_Res^2 ) / sum(thisList$cWeight)
cat("\nTDB 96 10-play has return:", round(nEX, 6), "and variance:", round(nEX2-nEX^2, 2))##
## TDB 96 10-play has return: -0.184602 and variance: 1962.11proc.time() - startTime## user system elapsed
## 13.34 1.09 14.51The timing is nearly identical; the processing by row does not seem to save any substantial amounts of time.
Next, the microbenchmark library is explored on some sample data to better understand the timing implications of various matrix approaches. Each row of the matrices is an independent instanciation that should be preserved, with columns multiplied in an “outer product” manner, then summarized back:
library(microbenchmark)
# Approach one is to multiply out all columns corresponding to a key result
testByRes <- function(dOne=dataOne, dTwo=dataTwo, dOut=dataOut,
cUq=colRes_uq, cTot=colRes) {
for (intCtr in seq_along(cUq)) {
keyColN <- row(cTot)[cTot == cUq[intCtr]]
keyColM <- col(cTot)[cTot == cUq[intCtr]]
dOut[, intCtr] <- rowSums( dOne$uq_Play[, keyColN, drop=FALSE] *
dTwo$uq_Play[, keyColM, drop=FALSE]
)
}
dOut
}
# Approach two is to run the process one row at a time
testByRow <- function(dOne=dataOne, dTwo=dataTwo, dOut=dataOut,
cUq=colRes_uq, cTot=colRes) {
mapScores <- match(as.vector(cTot), cUq)
for (intCtr in seq_len(nrow(dOne$uq_Play))) {
outMult <- outer(dOne$uq_Play[intCtr, ], dTwo$uq_Play[intCtr, ])
outGroup <- data.frame(keyRow=mapScores, keyVal=as.vector(outMult)) %>%
group_by(keyRow) %>%
summarize(keyVal=sum(keyVal))
dOut[intCtr, ] <- as.data.frame(outGroup)[, 2]
}
dOut
}The below runs are cached for run-time optimization:
# Matrix one will be the JB 96 2-play data, and matrix two will be the JB 96 2-play data
dataOne <- jb96_uq002
str(dataOne)## List of 3
## $ uq_Play: num [1:1279, 1:42] 0 0 0 0 0.493 ...
## $ uq_Res : num [1:42] -2 -1 0 1 2 3 4 5 6 7 ...
## $ cWeight: Named num [1:1279] 624 3744 54912 123552 96 ...
## ..- attr(*, "names")= chr [1:1279] "1" "2" "3" "4" ...dataTwo <- jb96_uq002
str(dataTwo)## List of 3
## $ uq_Play: num [1:1279, 1:42] 0 0 0 0 0.493 ...
## $ uq_Res : num [1:42] -2 -1 0 1 2 3 4 5 6 7 ...
## $ cWeight: Named num [1:1279] 624 3744 54912 123552 96 ...
## ..- attr(*, "names")= chr [1:1279] "1" "2" "3" "4" ...# The column addition results are calculated
colRes <- outer(dataOne$uq_Res, dataTwo$uq_Res, FUN="+")
str(colRes)## num [1:42, 1:42] -4 -3 -2 -1 0 1 2 3 4 5 ...colRes_uq <- sort(unique(as.vector(colRes)))
str(colRes_uq)## num [1:235] -4 -3 -2 -1 0 1 2 3 4 5 ...# The objective is then to matrix multiply the uqPlay data
dataOut <- matrix(data=0L, nrow=nrow(dataOne$uq_Play), ncol=length(colRes_uq))
str(dataOut)## int [1:1279, 1:235] 0 0 0 0 0 0 0 0 0 0 ...microbenchmark(tRes=(tempRes <- testByRes()),
tRow=(tempRow <- testByRow()),
times=10L
)## Unit: milliseconds
## expr min lq mean median uq max
## tRes 38.91487 39.4166 42.13662 40.50395 43.76521 50.79421
## tRow 1615.41942 1657.6538 1733.51017 1716.43070 1774.84840 1932.58546
## neval cld
## 10 a
## 10 b# Matrix one will be the JB 96 4-play data, and matrix two will be the JB 96 3-play data
dataOne <- jb96_uq004
str(dataOne)## List of 3
## $ uq_Play: num [1:1279, 1:235] 0 0 0 0 0.243 ...
## $ uq_Res : num [1:235] -4 -3 -2 -1 0 1 2 3 4 5 ...
## $ cWeight: Named num [1:1279] 624 3744 54912 123552 96 ...
## ..- attr(*, "names")= chr [1:1279] "1" "2" "3" "4" ...dataTwo <- jb96_uq003
str(dataTwo)## List of 3
## $ uq_Play: num [1:1279, 1:114] 0 0 0 0 0.346 ...
## $ uq_Res : num [1:114] -3 -2 -1 0 1 2 3 4 5 6 ...
## $ cWeight: Named num [1:1279] 624 3744 54912 123552 96 ...
## ..- attr(*, "names")= chr [1:1279] "1" "2" "3" "4" ...# The column addition results are calculated
colRes <- outer(dataOne$uq_Res, dataTwo$uq_Res, FUN="+")
str(colRes)## num [1:235, 1:114] -7 -6 -5 -4 -3 -2 -1 0 1 2 ...colRes_uq <- sort(unique(as.vector(colRes)))
str(colRes_uq)## num [1:898] -7 -6 -5 -4 -3 -2 -1 0 1 2 ...# The objective is then to matrix multiply the uqPlay data
dataOut <- matrix(data=0L, nrow=nrow(dataOne$uq_Play), ncol=length(colRes_uq))
str(dataOut)## int [1:1279, 1:898] 0 0 0 0 0 0 0 0 0 0 ...microbenchmark(tRes=(tempRes <- testByRes()),
tRow=(tempRow <- testByRow()),
times=10L
)## Unit: milliseconds
## expr min lq mean median uq max neval cld
## tRes 986.7236 1043.700 1146.076 1107.755 1225.944 1379.304 10 a
## tRow 4532.2317 4806.177 5083.608 5039.002 5254.335 5973.379 10 bRunning the results by unique outcome seems substantially faster than running results by hand flavor, at least for the 2x2 and 4x3 examples above.
Next, exploration of column sums by means of sapply is explored:
# Create and use aTest
create_Sapply01_mnPlay <- function(keyN, keyM) {
aTest <- matrix(data=0, nrow=nrow(keyN$uq_Play),
ncol=ncol(keyM$uq_Play)*ncol(keyN$uq_Play)
)
# Matrix multiply by "flavor" (unique rows)
for (intCtr in 1:nrow(keyN$uq_Play)) {
aTest[intCtr, ] <- as.vector( outer( keyN$uq_Play[intCtr, ], keyM$uq_Play[intCtr, ] ) )
}
# Sum outcomes for matrix cross product (column values for aTest)
aScore <- as.vector(outer(keyN$uq_Res, keyM$uq_Res, FUN="+"))
# Find and sort the unique scores
uqRes <- sort(unique(aScore))
# Convert the full aTest in to unique hands with values by column
keyRow <- 1:length(aScore)
keyCol <- match(aScore, uqRes)
uq_Play <- sapply(unique(sort(keyCol)),
FUN=function(x) { rowSums(aTest[, keyRow[keyCol==x], drop=FALSE]) }
)
list(uq_Play=uq_Play, uq_Res=uqRes, cWeight=keyN$cWeight)
}
# Run the aTest process on the line-by-line
create_Sapply02_mnPlay <- function(keyN, keyM) {
# Sum outcomes for matrix cross product (column values for aTest)
aScore <- as.vector(outer(keyN$uq_Res, keyM$uq_Res, FUN="+"))
# Find and sort the unique scores
uqRes <- sort(unique(aScore))
uq_Sapply <- matrix(data=0, nrow=nrow(keyN$uq_Play), ncol=length(uqRes))
# Find the key rows and columns, as well as who maps to who
keyRow <- 1:length(aScore)
keyCol <- match(aScore, uqRes)
keyMap <- lapply(unique(sort(keyCol)), FUN=function(x) { keyRow[keyCol==x] } )
# Matrix multiply by "flavor" (unique rows)
for (intCtr in 1:nrow(keyN$uq_Play)) {
keyVec <- as.vector( outer( keyN$uq_Play[intCtr, ], keyM$uq_Play[intCtr, ] ) )
uq_Sapply[intCtr, ] <-
sapply( keyMap, FUN=function(x) { sum(keyVec[x]) } )
}
list(uq_Play=uq_Sapply, uq_Res=uqRes, cWeight=keyN$cWeight)
}The methodologies are benchmarked, with results cached since running 5-10 times for each starts to take some time:
# Create JB96_uq007 for reference
startTime <- proc.time()
jb96_uq007 <- create_mnPlay(keyN=jb96_uq004, keyM=jb96_uq003)
proc.time() - startTime## user system elapsed
## 27.55 0.04 27.91# Explore the JB 96 2x2 case
microbenchmark(sap01=(jb96_test01_uq004 <- create_Sapply01_mnPlay(keyN=jb96_uq002, keyM=jb96_uq002)),
sap02=(jb96_test02_uq004 <- create_Sapply02_mnPlay(keyN=jb96_uq002, keyM=jb96_uq002)),
times=10L
)## Unit: milliseconds
## expr min lq mean median uq max neval cld
## sap01 100.0951 104.602 107.4139 106.5394 111.4320 114.1720 10 a
## sap02 471.2414 478.782 494.6737 491.2378 502.0267 533.9295 10 ball.equal(jb96_uq004, jb96_test01_uq004)## [1] TRUEall.equal(jb96_uq004, jb96_test02_uq004)## [1] TRUE# Explore the JB 96 4x3 case
microbenchmark(tRes=(tempRes <- testByRes()),
sap01=(jb96_test01_uq007 <- create_Sapply01_mnPlay(keyN=jb96_uq004, keyM=jb96_uq003)),
sap02=(jb96_test02_uq007 <- create_Sapply02_mnPlay(keyN=jb96_uq004, keyM=jb96_uq003)),
times=5L
)## Unit: milliseconds
## expr min lq mean median uq max neval cld
## tRes 947.1779 960.9695 987.9195 972.066 976.9116 1082.472 5 a
## sap01 1522.3668 1529.1656 1547.0828 1529.889 1556.7866 1597.206 5 b
## sap02 2414.6411 2442.9209 2489.6417 2494.403 2541.7137 2554.529 5 call.equal(jb96_uq007, jb96_test01_uq007)## [1] TRUEall.equal(jb96_uq007, jb96_test02_uq007)## [1] TRUEall.equal(jb96_uq007$uq_Play, tempRes)## [1] TRUE# Explore the JB 96 5x5 case (not cleaned)
dataOne <- jb96_uq005
dataTwo <- jb96_uq005
colRes <- outer(dataOne$uq_Res, dataTwo$uq_Res, FUN="+")
colRes_uq <- sort(unique(as.vector(colRes)))
dataOut <- matrix(data=0L, nrow=nrow(dataOne$uq_Play), ncol=length(colRes_uq))
microbenchmark(tRes=(tempRes <- testByRes()),
sap02=(jb96_test02_uq010 <- create_Sapply02_mnPlay(keyN=jb96_uq005, keyM=jb96_uq005)),
times=5L
)## Unit: seconds
## expr min lq mean median uq max neval cld
## tRes 10.215711 10.25875 10.304460 10.265196 10.33587 10.446773 5 b
## sap02 8.990372 9.00882 9.066402 9.075197 9.10341 9.154213 5 aall.equal(jb96_test02_uq010$uq_Play, tempRes)## [1] TRUE# Explore the JB 96 5x5 case (cleaned)
dataOne <- clean_NPlay(nPlayInput=jb96_uq005)##
##
## Contributions to SUM: -59,268.7 -59,269.5 (100%) 0.8 (0%)
## Contributions to SUM-SQUARED: 355,801,979 355,800,279 (100%) 1,700 (0%)
##
## Means Assuming All, Large, Small: -0.022805 -0.022805 1300.044
## Variances Assuming All, Large, Small: 136.9012 136.9005 1,086,441
##
## Means shifted from/to: -0.022805 -0.022805
## E[X^2] shifted from/to: 136.902 136.901dataTwo <- clean_NPlay(nPlayInput=jb96_uq005)##
##
## Contributions to SUM: -59,268.7 -59,269.5 (100%) 0.8 (0%)
## Contributions to SUM-SQUARED: 355,801,979 355,800,279 (100%) 1,700 (0%)
##
## Means Assuming All, Large, Small: -0.022805 -0.022805 1300.044
## Variances Assuming All, Large, Small: 136.9012 136.9005 1,086,441
##
## Means shifted from/to: -0.022805 -0.022805
## E[X^2] shifted from/to: 136.902 136.901colRes <- outer(dataOne$uq_Res, dataTwo$uq_Res, FUN="+")
colRes_uq <- sort(unique(as.vector(colRes)))
dataOut <- matrix(data=0L, nrow=nrow(dataOne$uq_Play), ncol=length(colRes_uq))
microbenchmark(tRes=(tempRes <- testByRes()),
sap02=(jb96_test02_uq010_cl <- create_Sapply02_mnPlay(keyN=dataOne, keyM=dataTwo)),
times=5L
)## Unit: seconds
## expr min lq mean median uq max neval cld
## tRes 2.800481 2.828953 2.853132 2.843240 2.874086 2.918899 5 a
## sap02 4.586511 4.707182 4.785808 4.811403 4.903698 4.920247 5 ball.equal(jb96_test02_uq010_cl$uq_Play, tempRes)## [1] TRUE# Explore the JB 96 10x5 case (cleaned)
dataOne <- clean_NPlay(nPlayInput=jb96_test02_uq010)##
##
## Contributions to SUM: -118,537.4 -118,551.2 (100.01%) 13.7 (-0.01%)
## Contributions to SUM-SQUARED: 967,134,937 967,097,447 (100%) 37,490 (0%)
##
## Means Assuming All, Large, Small: -0.04561 -0.045615 1978.338
## Variances Assuming All, Large, Small: 372.1217 372.1073 1,484,668
##
## Means shifted from/to: -0.04561 -0.045614
## E[X^2] shifted from/to: 372.124 372.11dataTwo <- clean_NPlay(nPlayInput=jb96_uq005)##
##
## Contributions to SUM: -59,268.7 -59,269.5 (100%) 0.8 (0%)
## Contributions to SUM-SQUARED: 355,801,979 355,800,279 (100%) 1,700 (0%)
##
## Means Assuming All, Large, Small: -0.022805 -0.022805 1300.044
## Variances Assuming All, Large, Small: 136.9012 136.9005 1,086,441
##
## Means shifted from/to: -0.022805 -0.022805
## E[X^2] shifted from/to: 136.902 136.901colRes <- outer(dataOne$uq_Res, dataTwo$uq_Res, FUN="+")
colRes_uq <- sort(unique(as.vector(colRes)))
dataOut <- matrix(data=0L, nrow=nrow(dataOne$uq_Play), ncol=length(colRes_uq))
microbenchmark(tRes=(tempRes <- testByRes()),
sap02=(jb96_test02_uq015_cl <- create_Sapply02_mnPlay(keyN=dataOne, keyM=dataTwo)),
times=5L
)## Unit: seconds
## expr min lq mean median uq max neval cld
## tRes 10.85795 11.03593 11.0697 11.10861 11.17259 11.17342 5 b
## sap02 10.49496 10.62467 10.6816 10.65275 10.73128 10.90436 5 aall.equal(jb96_test02_uq015_cl$uq_Play, tempRes)## [1] TRUEThe tRes and sap02 approaches are especially attractive since they do not hog memory (running one result at a time or one row at a time) regardless of underlying matrix sizes. An especially attractive approach seems to be:
- Understand the potential outcomes, based on the unique outer products (FUN=“+”) of the outcome vectors that are provided as inputs
- Approach 1 (testByRes) cycles over each of the unique potential outcomes, finds the column combinations that produce that unique potential outcome, and runs the full sum-product of the column multiplication
- Approach 2 (create_Sapply02_mnPlay) cycles over each of the flavors (rows), runs the full outer product, and then sums subsets to the appropriate unique potential outcomes for that flavor
For the modest sized m/n, testByRes appears to be faster, though there may be benefits to running by row as the m/n become larger. Combined with the cleaning approach for very rare hands, this shows significant promise for expanding the n-play outcome vectors without overly taxing memory and/or CPU.
In particular, timing for expanding out to larger N-Play is so far manageable. The process includes:
- Clean the underlying n-play data file of any very small probabilities (with the EV and likelihood combined instead in to a single record)
- Find the outer-product (FUN=“+”) of the potential outcomes
- Gather the resulting probabilities either “by result” or “by row”
Analysis of Individual Games
Next, an individual game is defined and then run through the key components of the process to get the N-play data:
genGame <- function(hnd2Score, useGameName, cWeight=cardWeight) {
gameIndex <- seq_len(nrow(hnd2Score)) - 1
gameList <- simGame(h2S=hnd2Score)
findMeanVar(useList=gameList, useName=useGameName) # Mean and variance on deal
gameHolds <- findHolds(idxKeep=gameList$tempSmallMax[2, ]) # Cards held
# Simulate for percentiles
set.seed(2017010108)
gameSim <- simPercentile(keyList=gameList, useName=useGameName)
# Investigate the pattern of initial deal EV
data.frame(rndScore=round(rep(gameList$tempSmallMax[1, ], times=cWeight), 0)) %>%
group_by(rndScore) %>%
summarize(ct=n(), per=round(choose(52, 5)/ct, 1)) %>%
print.data.frame()
# Assess JB 95 game for variance on the deal
gameDraws <- simDrawVar(aT=aType, mtxI=mtxIndices, useHolds=gameList$tempSmallMax[2, ],
cardI=cardIndex, cardW=cWeight, startT=startTime,
grTitle="EV Draw Simulation Results", allOut=FALSE
)
calcMeanVar(tempDraws=gameDraws, hnd2Score=hnd2Score, mainName=useGameName)
# Find the unique lists associated to the game, with key statistics
gameUniqueList <- indMeanVar(hnd2Score=hnd2Score, listDraws=gameDraws,
useName=useGameName, allOut=TRUE
)
graphMeanVar(useFrame=gameUniqueList$uqFrame, useName=useGameName) # EV/variance graphed by hold
assessFlavor(uqList=gameUniqueList) # Table of EV/variance by "hold-N"
totOutcomes(keyList=gameUniqueList, useName=useGameName) # Overall game return table
# Create straight-up as 1/3/5/10-play
game_01Play <- assessNPlay(keyList=gameUniqueList, nPlay=1L)
game_03Play <- assessNPlay(keyList=gameUniqueList, nPlay=3L)
game_05Play <- assessNPlay(keyList=gameUniqueList, nPlay=5L)
game_10Play <- assessNPlay(keyList=gameUniqueList, nPlay=10L)
# Simulate 16,000 hands of 10-play and 5-play
set.seed(1701010756)
game_10Sim <- sim_NPlay(keyFrame=game_10Play$out10Play, useName=useGameName,
nPlay=10, nHands=16000, nSim=2000
)
set.seed(101201708)
game_05Sim <- sim_NPlay(keyFrame=game_05Play$dfOutcome, useName=useGameName,
nPlay=5, nHands=16000, nSim=2000
)
# Try the more efficient N-play approach, extended with sapply02
game_uq001 <- get_uq1Play(keyList=gameUniqueList)
game_uq002 <- create_Sapply02_mnPlay(keyN=game_uq001, keyM=game_uq001)
game_uq003 <- create_Sapply02_mnPlay(keyN=game_uq002, keyM=game_uq001)
game_uq005 <- create_Sapply02_mnPlay(keyN=game_uq003, keyM=game_uq002)
game_uq010 <- create_Sapply02_mnPlay(keyN=game_uq005, keyM=game_uq005)
print(all.equal(game_10Play$out10Play$nOutcome, game_uq010$uq_Res))
print(all.equal(game_10Play$out10Play$wts, colSums(game_uq010$cWeight * game_uq010$uq_Play)))
# Return a large list of key data
list(gameName=useGameName,
gameList=gameList,
gameHolds=gameHolds,
gameSim=gameSim,
gameDraws=gameDraws,
gameUniqueList=gameUniqueList,
game_01Play=game_01Play,
game_03Play=game_03Play,
game_05Play=game_05Play,
game_10Play=game_10Play,
game_10Sim=game_10Sim,
game_05Sim=game_05Sim,
game_uq001=game_uq001,
game_uq002=game_uq002,
game_uq003=game_uq003,
game_uq005=game_uq005,
game_uq010=game_uq010
)
}The data are run for the JB 95 game, with holds extracted and compared to JB 96:
# Define the paytable and simulate the holds (JB 95)
startTime <- proc.time()
jb95hnd2Score <- data.frame(idx=gameIndex, val=c( -1,
799, 49, 8, 4, 3,
2, 1, 0, 0, 0,
0, -1, -1, 24, 24,
24, 24, 24, 24, 24,
24, 24, 24, 24, 24
)
)
jb95GameData <- genGame(hnd2Score=jb95hnd2Score, useGameName="JB 95")## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -1.0000 -1.0000 -0.6651 -1.0000 799.0000
##
## # A tibble: 10 × 2
## aScores ct
## <dbl> <int>
## 1 -1 2062860
## 2 0 337920
## 3 1 123552
## 4 2 54912
## 5 3 10200
## 6 4 5108
## 7 8 3744
## 8 24 624
## 9 49 36
## 10 799 4
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -0.9375 -0.8750 -0.6651 -0.6250 24.0000
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.9107 -0.8138 -0.8138 -0.6651 -0.6624 3.2650
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.8122 -0.7731 -0.6898 -0.6651 -0.6506 0.5143
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.7196 -0.7068 -0.7068 -0.6651 -0.5687 -0.5602
##
##
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6444 -0.5205 -0.1763 -0.0155 -0.0426 799.0000
##
## [1] 0.9844981
## [1] "Game JB 95: Return: 0.9845 and Variance on Deal: 1.946"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -70.800 -23.660 -9.799 -7.074 5.587 792.100
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -73.28 -29.83 -20.05 -21.14 -10.71 13.54
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -106.500 -38.300 -17.860 -13.470 3.749 853.400
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -112.9000 -46.1600 -30.8800 -32.8300 -16.8500 0.5365
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -166.100 -62.780 -33.520 -30.410 -4.351 807.200
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -172.20 -74.77 -51.23 -53.82 -29.28 2.11
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -268.10 -109.80 -67.65 -58.96 -21.13 863.70
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -277.700 -122.400 -86.150 -89.890 -53.000 3.302
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -434.20 -190.10 -131.40 -123.10 -69.52 833.50
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -440.8000 -209.0000 -156.1000 -158.7000 -105.0000 -0.5941
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -700.6 -345.9 -263.8 -250.8 -181.1 986.6
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -723.2000 -367.9000 -289.8000 -291.7000 -215.9000 -0.6603
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -992.4 -525.4 -413.1 -391.4 -305.7 1357.0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -995.700 -546.600 -439.000 -441.300 -336.300 -2.219
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1334.0 -798.1 -643.4 -616.5 -495.6 1458.0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1334.00 -822.30 -672.60 -673.00 -538.20 -26.35
## rndScore ct per
## 1 -1 899100 2.9
## 2 0 1158420 2.2
## 3 1 341496 7.6
## 4 2 124500 20.9
## 5 3 65148 39.9
## 6 4 4952 524.8
## 7 8 3744 694.2
## 8 17 752 3456.1
## 9 18 52 49980.0
## 10 19 132 19689.1
## 11 24 624 4165.0
## 12 49 36 72193.3
## 13 799 4 649740.0
## [1] 2598960 27
## [1] 270725 27
## [1] 22100 27
## [1] 1326 27
## [1] 52 27
## [1] 1 27
## idx 0 1 2 3 4 5 6 7 8 9 10 11
## [1,] 0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
## 12 13 14 15 16 17 18 19 20 21 22 23 24 25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1
##
## Summary of JB 95 starting with row sums
##
## 1 47 1081 16215 178365 1533939
## 2210 18052 9465 81990 18897 3845
##
## 1
## 134459
##
## [1] "JB 95: Overall EV and Mean"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6444 -0.5205 -0.1763 -0.0155 -0.0426 799.0000
## [1] "Overall Return: 0.984498"
##
## [1] "JB 95: Variances (Deal, Draw)"
## [1] "Deal Variance: 1.946"
## [1] "Draw Variance Summary Statistics"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 2.579 3.549 17.550 4.428 13300.000
##
##
## This will assess the JB 95 means and variances
##
## 1 -1 2 14 15
## 2 799 3
## 3 49 4
## 4 8 5
## 5 4 6
## 6 3 7
## 7 2 8
## 8 1 9
## 9 0 10 11 12 13
## 10 24 16 17 18 19 20 21 22 23 24 25 26 27
## [1] 1269
## num [1:1269, 1:10] 0 0 0 0 33 ...
## rSum ct
## 1 1 6
## 2 47 34
## 3 1081 104
## 4 16215 95
## 5 178365 155
## 6 1533939 875
## chr [1:134459] "0-0-0-0-0-0-0-0-0-1" "0-0-0-0-0-0-0-0-0-1" ...
## chr [1:1269] "0-0-0-0-0-0-0-0-0-1" "0-0-0-1-0-0-0-0-0-0" ...
## int [1:134459] 1 1 1 1 1 1 1 1 1 1 ...
## num [1:1269(1d)] 624 3744 54912 123552 96 ...
## - attr(*, "dimnames")=List of 1
## ..$ : chr [1:1269] "1" "2" "3" "4" ...
## [1] 0.9844981
## [1] 17.54967
## scoreType occPer contRet occFreq
## 2 799 40170.000 0.019891 0.00002490
## 3 49 9326.000 0.005254 0.00010723
## 10 24 423.200 0.056710 0.00236293
## 4 8 86.850 0.092112 0.01151397
## 5 4 91.810 0.043570 0.01089239
## 6 3 89.040 0.033692 0.01123055
## 7 2 13.430 0.148930 0.07446523
## 8 1 7.734 0.129303 0.12930324
## 9 0 4.648 0.000000 0.21513533
## 1 -1 1.835 -0.544964 0.54496425
##
## Printed table suggests JB 95 mean return: 0.984498 and overall variance: 19.49883
##
## List of 1
## $ : int [1:10] 1 2 3 4 5 6 7 8 9 10
##
## 1
## 1269
## int [1:10, 1] 1 2 3 4 5 6 7 8 9 10
## [,1]
## [1,] 1
## [2,] 2
## [3,] 3
## [4,] 4
## [5,] 5
## [6,] 6
##
##
## Number of unique outcome types: 10
##
## Moving to assess the: 10 rows of outcomes
##
##
## Mean: 0.9844981 Variance: 19.49564
## List of 3
## $ : int [1:1000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1000] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1269
## int [1:1000, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3]
## [1,] 1 1 1
## [2,] 1 1 2
## [3,] 1 1 3
## [4,] 1 1 4
## [5,] 1 1 5
## [6,] 1 1 6
##
##
## Number of unique outcome types: 114
##
## Moving to assess the: 114 rows of outcomes
## num [1:1269, 1:3, 1:6] 0 0 0 0 0 ...
## num [1:1269, 1:6] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1269] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##
##
## Mean: 0.9844981 Variance: 70.16269
## List of 5
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1269
## int [1:100000, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 406
##
## Moving to assess the: 406 rows of outcomes
## num [1:1269, 1:45] 0 0 0 0 0.000157 ...
## num [1:1269] 0 0 0 0 0.00157 ...
## [1] 100
## num [1:1269, 1:250] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1269] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1269, 1:270] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1269] 0 0 0 0 0 ...
## [1] 300
## num [1:1269, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1269] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
##
##
## Mean: 0.9844981 Variance: 136.3974
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1269
## int [1:100000, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 406
##
## Moving to assess the: 406 rows of outcomes
## num [1:1269, 1:45] 0 0 0 0 0.000157 ...
## num [1:1269] 0 0 0 0 0.00157 ...
## [1] 100
## num [1:1269, 1:250] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1269] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1269, 1:270] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1269] 0 0 0 0 0 ...
## [1] 300
## num [1:1269, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1269] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
##
##
## Mean: 0.9844981 Variance: 370.0931
##
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.446% with total variance (sd as % of total bet): 5,647,675 ( 1.49% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0427 -0.0366 -0.0324 -0.0251 -0.0173 -0.0071 0.0018 0.0101 0.0334
##
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.4% with total variance (sd as % of total bet): 2,128,016 ( 1.82% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0509 -0.0433 -0.0377 -0.0280 -0.0175 -0.0058 0.0073 0.0158 0.0370
## num [1:1269, 1:10] 0 0 0 0 0.702 ...
## - attr(*, "dimnames")=List of 2
## ..$ : NULL
## ..$ : chr [1:10] "" "" "" "" ...
## [1] TRUE
## [1] TRUEproc.time() - startTime## user system elapsed
## 119.31 13.70 133.91# Extract JB 95 holds from JB 95 game data, and compare with JB 96
jb95Holds <- jb95GameData$gameHolds
jb96_vs_jb95Holds <- diffHolds(jb96Holds, jb95Holds)
sum(jb96_vs_jb95Holds)## [1] 627if (sum(jb96_vs_jb95Holds) > 0) {
cbind(cardSmall[jb96_vs_jb95Holds, ],
jb96Holds[jb96_vs_jb95Holds, ],
jb95Holds[jb96_vs_jb95Holds, ]
)[sort(sample(1:sum(jb96_vs_jb95Holds), 20)), ]
}## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
## [1,] 1 5 10 12 23 1 5 10 12 NA 1 NA 10
## [2,] 1 7 10 12 23 1 7 10 12 NA 1 NA 10
## [3,] 1 4 9 23 25 NA NA NA 23 25 1 NA NA
## [4,] 1 4 13 24 25 NA NA NA 24 25 1 NA 13
## [5,] 1 6 10 13 25 1 6 10 13 NA 1 NA 10
## [6,] 1 8 10 11 26 1 8 10 11 NA 1 NA 10
## [7,] 2 10 13 16 20 NA 10 13 NA NA NA NA 13
## [8,] 2 10 13 17 31 NA 10 13 NA NA NA NA 13
## [9,] 2 10 13 20 21 NA 10 13 NA NA NA NA 13
## [10,] 7 10 13 15 34 NA 10 13 NA NA NA NA 13
## [11,] 10 11 15 34 52 10 11 NA NA NA NA 11 NA
## [12,] 3 10 13 17 34 NA 10 13 NA NA NA NA 13
## [13,] 3 5 6 23 24 3 5 6 NA NA NA NA NA
## [14,] 3 8 23 24 39 NA NA 23 24 NA NA NA NA
## [15,] 4 5 6 25 26 4 5 6 NA NA NA NA NA
## [16,] 4 6 7 25 39 4 6 7 NA NA NA NA NA
## [17,] 10 11 17 26 34 10 11 NA NA NA NA 11 NA
## [18,] 5 7 8 25 39 5 7 8 NA NA NA NA NA
## [19,] 8 10 12 18 37 8 10 12 NA NA NA NA 12
## [20,] 10 11 19 35 52 10 11 NA NA NA NA 11 NA
## [,14] [,15]
## [1,] 12 NA
## [2,] 12 NA
## [3,] NA 25
## [4,] 24 25
## [5,] 13 NA
## [6,] 11 NA
## [7,] NA NA
## [8,] NA NA
## [9,] NA NA
## [10,] NA NA
## [11,] NA 52
## [12,] NA NA
## [13,] 23 24
## [14,] 24 39
## [15,] 25 26
## [16,] 25 39
## [17,] 26 NA
## [18,] 25 39
## [19,] NA 37
## [20,] NA 52The data are run for the BP 75 game, with holds extracted and compared to BP 85:
# Define the paytable and simulate the holds (BP 75)
startTime <- proc.time()
bp75hnd2Score <- data.frame(idx=gameIndex, val=c( -1,
799, 49, 6, 4, 3,
2, 1, 0, 0, 0,
0, -1, -1, 79, 79,
79, 39, 39, 39, 39,
24, 24, 24, 24, 24
)
)
bp75GameData <- genGame(hnd2Score=bp75hnd2Score, useGameName="BP 75")## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -1.0000 -1.0000 -0.6661 -1.0000 799.0000
##
## # A tibble: 12 × 2
## aScores ct
## <dbl> <int>
## 1 -1 2062860
## 2 0 337920
## 3 1 123552
## 4 2 54912
## 5 3 10200
## 6 4 5108
## 7 6 3744
## 8 24 432
## 9 39 144
## 10 49 36
## 11 79 48
## 12 799 4
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -0.9375 -0.8750 -0.6661 -0.6250 79.0000
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.9107 -0.8138 -0.8138 -0.6661 -0.6624 5.3880
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.8141 -0.7741 -0.6916 -0.6661 -0.6524 0.6294
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.7193 -0.7093 -0.7093 -0.6661 -0.5712 -0.5609
##
##
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6447 -0.5199 -0.1967 -0.0198 -0.0426 799.0000
##
## [1] 0.9801469
## [1] "Game BP 75: Return: 0.98015 and Variance on Deal: 2.08"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -70.000 -26.620 -13.060 -9.365 3.065 790.600
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -72.60 -32.01 -22.07 -22.93 -12.22 11.62
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -112.5000 -42.9500 -23.5000 -17.4900 0.3269 845.9000
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -119.4000 -51.5400 -34.9700 -36.4700 -19.5400 0.5162
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -176.40 -74.06 -44.92 -39.60 -12.68 795.80
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -177.200 -83.600 -60.250 -61.680 -35.680 1.259
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -296.00 -130.10 -86.67 -76.16 -36.33 837.40
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -296.00 -141.60 -103.90 -105.70 -68.06 3.18
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -471.9 -229.6 -168.8 -158.8 -102.0 788.2
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -472.500 -247.000 -190.800 -192.400 -134.400 -2.658
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -750.8 -424.0 -341.0 -321.9 -245.6 945.5
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -762.700 -442.400 -361.700 -359.100 -277.800 -4.474
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1109.0 -642.8 -525.9 -501.3 -405.4 1237.0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1148.000 -663.000 -549.000 -546.500 -438.000 -4.912
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1565.0 -984.6 -814.7 -790.8 -654.1 1351.0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1565.0 -1005.0 -849.3 -839.5 -692.6 -47.5
## rndScore ct per
## 1 -1 911328 2.9
## 2 0 1146192 2.3
## 3 1 465048 5.6
## 4 2 948 2741.5
## 5 3 48252 53.9
## 6 4 17624 147.5
## 7 6 7968 326.2
## 8 17 752 3456.1
## 9 18 52 49980.0
## 10 19 132 19689.1
## 11 24 432 6016.1
## 12 39 144 18048.3
## 13 49 36 72193.3
## 14 79 48 54145.0
## 15 799 4 649740.0
## [1] 2598960 27
## [1] 270725 27
## [1] 22100 27
## [1] 1326 27
## [1] 52 27
## [1] 1 27
## idx 0 1 2 3 4 5 6 7 8 9 10 11
## [1,] 0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
## 12 13 14 15 16 17 18 19 20 21 22 23 24 25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1
##
## Summary of BP 75 starting with row sums
##
## 1 47 1081 16215 178365 1533939
## 2210 18087 9462 81940 18915 3845
##
## 1
## 134459
##
## [1] "BP 75: Overall EV and Mean"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6447 -0.5199 -0.1967 -0.0198 -0.0426 799.0000
## [1] "Overall Return: 0.980147"
##
## [1] "BP 75: Variances (Deal, Draw)"
## [1] "Deal Variance: 2.0801"
## [1] "Draw Variance Summary Statistics"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 2.260 3.256 18.670 5.831 13300.000
##
##
## This will assess the BP 75 means and variances
##
## 1 -1 2 14 15
## 2 799 3
## 3 49 4
## 4 6 5
## 5 4 6
## 6 3 7
## 7 2 8
## 8 1 9
## 9 0 10 11 12 13
## 10 79 16 17 18
## 11 39 19 20 21 22
## 12 24 23 24 25 26 27
## [1] 1647
## num [1:1647, 1:12] 0 0 0 0 0 0 0 0 33 0 ...
## rSum ct
## 1 1 8
## 2 47 34
## 3 1081 106
## 4 16215 95
## 5 178365 451
## 6 1533939 953
## chr [1:134459] "0-0-0-0-0-0-0-0-0-1-0-0" ...
## chr [1:1647] "0-0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-0-0-1-0" ...
## int [1:134459] 1 1 1 1 1 1 1 1 1 1 ...
## num [1:1647(1d)] 48 144 432 3744 4224 ...
## - attr(*, "dimnames")=List of 1
## ..$ : chr [1:1647] "1" "2" "3" "4" ...
## [1] 0.9801469
## [1] 18.6737
## scoreType occPer contRet occFreq
## 2 799 40230.000 0.019859 0.00002485
## 10 79 5106.000 0.015471 0.00019584
## 3 49 9346.000 0.005243 0.00010699
## 11 39 1897.000 0.020563 0.00052725
## 12 24 610.100 0.039339 0.00163914
## 4 6 86.870 0.069069 0.01151142
## 5 4 91.880 0.043535 0.01088366
## 6 3 88.740 0.033805 0.01126847
## 7 2 13.430 0.148873 0.07443631
## 8 1 7.736 0.129263 0.12926285
## 9 0 4.645 0.000000 0.21527153
## 1 -1 1.835 -0.544872 0.54487169
##
## Printed table suggests BP 75 mean return: 0.980148 and overall variance: 20.75093
##
## List of 1
## $ : int [1:12] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1647
## int [1:12, 1] 1 2 3 4 5 6 7 8 9 10 ...
## [,1]
## [1,] 1
## [2,] 2
## [3,] 3
## [4,] 4
## [5,] 5
## [6,] 6
##
##
## Number of unique outcome types: 12
##
## Moving to assess the: 12 rows of outcomes
##
##
## Mean: 0.9801469 Variance: 20.75378
## List of 3
## $ : int [1:1728] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1728] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1728] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1647
## int [1:1728, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3]
## [1,] 1 1 1
## [2,] 1 1 2
## [3,] 1 1 3
## [4,] 1 1 4
## [5,] 1 1 5
## [6,] 1 1 6
##
##
## Number of unique outcome types: 194
##
## Moving to assess the: 194 rows of outcomes
## num [1:1647, 1:3, 1:6] 0 0 0 1 0.0611 ...
## num [1:1647, 1:6] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##
##
## Mean: 0.9801469 Variance: 74.74178
## List of 5
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1647
## int [1:248832, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 716
##
## Moving to assess the: 716 rows of outcomes
## num [1:1647, 1:1230] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 ...
## [1] 100
## num [1:1647, 1:150] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1647, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
## num [1:1647, 1:360] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
## num [1:1647, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
## num [1:1647, 1:150] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
## num [1:1647, 1:10] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
##
##
## Mean: 0.9801469 Variance: 145.3704
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1647
## int [1:248832, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 716
##
## Moving to assess the: 716 rows of outcomes
## num [1:1647, 1:1230] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 ...
## [1] 100
## num [1:1647, 1:150] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1647, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
## num [1:1647, 1:360] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
## num [1:1647, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
## num [1:1647, 1:150] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
## num [1:1647, 1:10] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
##
##
## Mean: 0.9801469 Variance: 394.7444
##
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 98.009% with total variance (sd as % of total bet): 6,005,956 ( 1.53% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0487 -0.0418 -0.0377 -0.0299 -0.0215 -0.0114 -0.0022 0.0061 0.0303
##
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 97.962% with total variance (sd as % of total bet): 2,289,651 ( 1.89% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0568 -0.0491 -0.0439 -0.0326 -0.0218 -0.0095 0.0037 0.0124 0.0360
## num [1:1647, 1:12] 0 0 0 0 0 ...
## - attr(*, "dimnames")=List of 2
## ..$ : NULL
## ..$ : chr [1:12] "" "" "" "" ...
## [1] TRUE
## [1] TRUEproc.time() - startTime## user system elapsed
## 159.51 17.80 177.95# Extract BP 75 holds from BP 75 game data, and compare with BP 85
bp75Holds <- bp75GameData$gameHolds
bp85_vs_bp75Holds <- diffHolds(bp85Holds, bp75Holds)
sum(bp85_vs_bp75Holds)## [1] 47if (sum(bp85_vs_bp75Holds) > 0) {
cbind(cardSmall[bp85_vs_bp75Holds, ],
bp85Holds[bp85_vs_bp75Holds, ],
bp75Holds[bp85_vs_bp75Holds, ]
)[sort(sample(1:sum(bp85_vs_bp75Holds), 20)), ]
}## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
## [1,] 9 10 11 22 25 9 NA NA 22 NA 9 10 11
## [2,] 9 10 12 22 24 9 NA NA 22 NA 9 10 12
## [3,] 9 10 12 22 37 9 NA NA 22 NA 9 10 12
## [4,] 9 11 22 36 38 9 NA 22 NA NA 9 11 NA
## [5,] 9 22 37 49 51 9 22 NA NA NA 9 NA 37
## [6,] 9 10 22 37 51 9 NA 22 NA NA 9 10 NA
## [7,] 9 11 22 36 51 9 NA 22 NA NA 9 11 NA
## [8,] 9 10 11 23 25 NA 10 NA 23 NA 9 10 11
## [9,] 10 11 23 35 38 10 NA 23 NA NA 10 11 NA
## [10,] 10 23 35 50 51 10 23 NA NA NA 10 NA 35
## [11,] 9 10 23 24 38 NA 10 23 NA NA 9 10 NA
## [12,] 9 10 23 25 37 NA 10 23 NA NA 9 10 NA
## [13,] 9 10 23 37 51 NA 10 23 NA NA 9 10 NA
## [14,] 10 11 23 35 51 10 NA 23 NA NA 10 11 NA
## [15,] 10 12 23 35 50 10 NA 23 NA NA 10 12 NA
## [16,] 2 3 4 14 36 NA NA NA 14 NA 2 3 4
## [17,] 2 3 5 14 36 NA NA NA 14 NA 2 3 5
## [18,] 4 5 7 21 37 NA NA NA NA 37 4 5 7
## [19,] 7 8 11 23 39 NA NA 11 NA 39 7 8 11
## [20,] 7 10 11 21 39 NA NA 11 NA 39 7 10 11
## [,14] [,15]
## [1,] NA 25
## [2,] NA 24
## [3,] NA 37
## [4,] 36 38
## [5,] 49 51
## [6,] 37 51
## [7,] 36 51
## [8,] NA 25
## [9,] 35 38
## [10,] 50 51
## [11,] 24 38
## [12,] 25 37
## [13,] 37 51
## [14,] 35 51
## [15,] 35 50
## [16,] NA NA
## [17,] NA NA
## [18,] NA NA
## [19,] NA NA
## [20,] NA NAThe data are run for the DDB 96 game, with the pay table having been previously created above:
# Use the previously existing pay table (print for reference) and simulate DDB 96
startTime <- proc.time()
ddb96hnd2Score## idx val
## 1 0 -1
## 2 1 799
## 3 2 49
## 4 3 8
## 5 4 5
## 6 5 3
## 7 6 2
## 8 7 0
## 9 8 0
## 10 9 0
## 11 10 0
## 12 11 0
## 13 12 -1
## 14 13 -1
## 15 14 399
## 16 15 159
## 17 16 159
## 18 17 159
## 19 18 159
## 20 19 79
## 21 20 79
## 22 21 49
## 23 22 49
## 24 23 49
## 25 24 49
## 26 25 49ddb96GameData <- genGame(hnd2Score=ddb96hnd2Score, useGameName="DDB 96")## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -1.0000 -1.0000 -0.6988 -1.0000 799.0000
##
## # A tibble: 11 × 2
## aScores ct
## <dbl> <int>
## 1 -1 2062860
## 2 0 461472
## 3 2 54912
## 4 3 10200
## 5 5 5108
## 6 8 3744
## 7 49 468
## 8 79 108
## 9 159 72
## 10 399 12
## 11 799 4
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -0.9375 -0.8750 -0.6988 -0.7500 219.0000
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.9337 -0.8367 -0.8367 -0.6988 -0.6854 11.2200
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.8501 -0.8094 -0.7277 -0.6988 -0.6885 0.8302
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.7473 -0.7456 -0.7430 -0.6988 -0.6075 -0.5743
##
##
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6770 -0.5414 -0.2668 -0.0102 0.1489 799.0000
##
## [1] 0.9898078
## [1] "Game DDB 96: Return: 0.98981 and Variance on Deal: 4.809"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -81.850 -30.000 -13.370 -5.006 9.338 797.900
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -84.16 -38.14 -25.88 -26.91 -14.04 19.88
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -129.400 -47.810 -22.160 -7.103 13.500 867.200
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -140.00 -60.04 -38.39 -41.59 -21.12 1.82
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -205.30 -78.33 -37.62 -21.65 11.32 858.90
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -205.900 -95.590 -64.470 -67.480 -34.210 5.765
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -343.60 -128.40 -62.35 -36.31 21.62 1079.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -343.600 -151.300 -101.600 -106.900 -55.640 4.366
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -524.500 -209.300 -113.000 -84.580 3.117 975.300
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -531.600 -245.300 -171.400 -177.400 -96.770 0.078
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -812.20 -357.50 -205.90 -170.20 -27.74 1458.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -827.400 -406.800 -287.900 -291.200 -160.200 3.162
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1108.00 -512.40 -308.10 -263.10 -58.35 1602.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1123.000 -576.000 -403.300 -411.600 -239.800 4.502
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1687.0 -711.4 -436.7 -406.3 -152.1 2138.0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1715.000 -794.000 -560.800 -579.900 -349.900 -1.452
## rndScore ct per
## 1 -1 924432 2.8
## 2 0 1384716 1.9
## 3 1 213276 12.2
## 4 2 144 18048.3
## 5 3 11184 232.4
## 6 4 38016 68.4
## 7 5 4952 524.8
## 8 6 5760 451.2
## 9 7 6912 376.0
## 10 8 3456 752.0
## 11 11 1992 1304.7
## 12 12 2520 1031.3
## 13 17 608 4274.6
## 14 18 144 18048.3
## 15 19 184 14124.8
## 16 49 468 5553.3
## 17 99 108 24064.4
## 18 159 36 72193.3
## 19 220 36 72193.3
## 20 399 12 216580.0
## 21 799 4 649740.0
## [1] 2598960 27
## [1] 270725 27
## [1] 22100 27
## [1] 1326 27
## [1] 52 27
## [1] 1 27
## idx 0 1 2 3 4 5 6 7 8 9 10 11
## [1,] 0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
## 12 13 14 15 16 17 18 19 20 21 22 23 24 25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1
##
## Summary of DDB 96 starting with row sums
##
## 1 47 1081 16215 178365 1533939
## 2150 19685 9757 72889 27544 2434
##
## 1
## 134459
##
## [1] "DDB 96: Overall EV and Mean"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6770 -0.5414 -0.2668 -0.0102 0.1489 799.0000
## [1] "Overall Return: 0.989808"
##
## [1] "DDB 96: Variances (Deal, Draw)"
## [1] "Deal Variance: 4.809"
## [1] "Draw Variance Summary Statistics"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 5.080 8.414 37.180 20.000 13290.000
##
##
## This will assess the DDB 96 means and variances
##
## 1 -1 2 14 15
## 2 799 3
## 3 49 4 23 24 25 26 27
## 4 8 5
## 5 5 6
## 6 3 7
## 7 2 8
## 8 0 9 10 11 12 13
## 9 399 16
## 10 159 17 18 19 20
## 11 79 21 22
## [1] 1260
## num [1:1260, 1:11] 0 0 0 0 0 0 0 0 0 0 ...
## rSum ct
## 1 1 7
## 2 47 38
## 3 1081 118
## 4 16215 94
## 5 178365 507
## 6 1533939 496
## chr [1:134459] "0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-1-0-0" ...
## chr [1:1260] "0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-12-35-0" ...
## int [1:134459] 1 1 1 2 2 2 2 2 2 2 ...
## num [1:1260(1d)] 12 36 36 108 468 ...
## - attr(*, "dimnames")=List of 1
## ..$ : chr [1:1260] "1" "2" "3" "4" ...
## [1] 0.9898078
## [1] 37.17596
## scoreType occPer contRet occFreq
## 2 799 40800.000 0.019584 0.00002451
## 9 399 16240.000 0.024574 0.00006159
## 10 159 3157.000 0.050367 0.00031678
## 11 79 2601.000 0.030368 0.00038441
## 3 49 574.800 0.085249 0.00173978
## 4 8 92.080 0.086880 0.01086000
## 5 5 88.040 0.056793 0.01135853
## 6 3 78.330 0.038299 0.01276626
## 7 2 13.290 0.150530 0.07526513
## 8 0 2.991 0.000000 0.33438608
## 1 -1 1.809 -0.552837 0.55283693
##
## Printed table suggests DDB 96 mean return: 0.989807 and overall variance: 41.98492
##
## List of 1
## $ : int [1:11] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1260
## int [1:11, 1] 1 2 3 4 5 6 7 8 9 10 ...
## [,1]
## [1,] 1
## [2,] 2
## [3,] 3
## [4,] 4
## [5,] 5
## [6,] 6
##
##
## Number of unique outcome types: 11
##
## Moving to assess the: 11 rows of outcomes
##
##
## Mean: 0.9898078 Variance: 41.98498
## List of 3
## $ : int [1:1331] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1331] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1331] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1260
## int [1:1331, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3]
## [1,] 1 1 1
## [2,] 1 1 2
## [3,] 1 1 3
## [4,] 1 1 4
## [5,] 1 1 5
## [6,] 1 1 6
##
##
## Number of unique outcome types: 200
##
## Moving to assess the: 200 rows of outcomes
## num [1:1260, 1:3, 1:3] 0 0 0 0 0 ...
## num [1:1260, 1:3] 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 ...
## [1] 100
## num [1:1260, 1:3, 1] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260, 1] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##
##
## Mean: 0.9898078 Variance: 154.8091
## List of 5
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1260
## int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 1041
##
## Moving to assess the: 1041 rows of outcomes
## num [1:1260, 1:200] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## num [1:1260, 1:240] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1260, 1:10] 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 ...
## [1] 300
## num [1:1260, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
## num [1:1260, 1:145] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
## num [1:1260, 1:180] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
## num [1:1260, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
## num [1:1260, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
## num [1:1260, 1:30] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 900
## num [1:1260, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
##
##
## Mean: 0.9898078 Variance: 306.1054
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1260
## int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 1041
##
## Moving to assess the: 1041 rows of outcomes
## num [1:1260, 1:200] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## num [1:1260, 1:240] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1260, 1:10] 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 ...
## [1] 300
## num [1:1260, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
## num [1:1260, 1:145] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
## num [1:1260, 1:180] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
## num [1:1260, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
## num [1:1260, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
## num [1:1260, 1:30] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 900
## num [1:1260, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
##
##
## Mean: 0.9898078 Variance: 852.662
##
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.981% with total variance (sd as % of total bet): 13,247,804 ( 2.27% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0558 -0.0448 -0.0372 -0.0259 -0.0120 0.0037 0.0191 0.0295 0.0505
##
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 98.9% with total variance (sd as % of total bet): 4,951,298 ( 2.78% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0699 -0.0558 -0.0460 -0.0297 -0.0124 0.0066 0.0248 0.0342 0.0661
## num [1:1260, 1:11] 0 0 0 0 0 0 0 0 0 0 ...
## - attr(*, "dimnames")=List of 2
## ..$ : NULL
## ..$ : chr [1:11] "" "" "" "" ...
## [1] TRUE
## [1] TRUEproc.time() - startTime## user system elapsed
## 169.93 20.16 191.17Next, a function is written to explore 1/3/5/10 data for a game of choice:
graphGameFull <- function(simPct, simGraph, gName) {
nSims <- nrow(simPct) - 2
nDealGraph <- simPct[2, simGraph]
par(mfcol=c(1, 2))
plot(x=(1:nSims)/nSims, y=simPct[-(1:2), simGraph[1]], col="red", cex=0.4,
xlab="Percentile", ylab="Return",
main=paste0(nDealGraph[1], " Deals of ", gName)
)
points(x=(1:nSims)/nSims, y=simPct[-(1:2), simGraph[1]+1], col="orange", cex=0.4)
points(x=(1:nSims)/nSims, y=simPct[-(1:2), simGraph[1]+2], col="blue", cex=0.4)
points(x=(1:nSims)/nSims, y=simPct[-(1:2), simGraph[1]+3], col="green", cex=0.4)
abline(h=0, v=c(0.01, 0.1, 0.5, 0.9), lty=2)
quan01 <- quantile(simPct[-(1:2), simGraph[1]], c(0.01, 0.1, 0.5, 0.9))
quan03 <- quantile(simPct[-(1:2), simGraph[1]+1], c(0.01, 0.1, 0.5, 0.9))
quan05 <- quantile(simPct[-(1:2), simGraph[1]+2], c(0.01, 0.1, 0.5, 0.9))
quan10 <- quantile(simPct[-(1:2), simGraph[1]+3], c(0.01, 0.1, 0.5, 0.9))
legend("topleft",
legend=c(paste0("1-play ( ", paste(round(quan01, 3), collapse=" "), " )"),
paste0("3-play ( ", paste(round(quan03, 3), collapse=" "), " )"),
paste0("5-play ( ", paste(round(quan05, 3), collapse=" "), " )"),
paste0("10-play ( ", paste(round(quan10, 3), collapse=" "), " )")
),
col=c("red", "orange", "blue", "green"), lwd=2, pch=19, cex=0.6
)
plot(x=(1:nSims)/nSims, y=simPct[-(1:2), simGraph[2]], col="red", cex=0.4,
xlab="Percentile", ylab="Return",
main=paste0(nDealGraph[2], " Deals of ", gName)
)
points(x=(1:nSims)/nSims, y=simPct[-(1:2), simGraph[2]+1], col="orange", cex=0.4)
points(x=(1:nSims)/nSims, y=simPct[-(1:2), simGraph[2]+2], col="blue", cex=0.4)
points(x=(1:nSims)/nSims, y=simPct[-(1:2), simGraph[2]+3], col="green", cex=0.4)
abline(h=0, v=c(0.01, 0.1, 0.5, 0.9), lty=2)
quan01 <- quantile(simPct[-(1:2), simGraph[2]], c(0.01, 0.1, 0.5, 0.9))
quan03 <- quantile(simPct[-(1:2), simGraph[2]+1], c(0.01, 0.1, 0.5, 0.9))
quan05 <- quantile(simPct[-(1:2), simGraph[2]+2], c(0.01, 0.1, 0.5, 0.9))
quan10 <- quantile(simPct[-(1:2), simGraph[2]+3], c(0.01, 0.1, 0.5, 0.9))
legend("topleft",
legend=c(paste0("1-play ( ", paste(round(quan01, 3), collapse=" "), " )"),
paste0("3-play ( ", paste(round(quan03, 3), collapse=" "), " )"),
paste0("5-play ( ", paste(round(quan05, 3), collapse=" "), " )"),
paste0("10-play ( ", paste(round(quan10, 3), collapse=" "), " )")
),
col=c("red", "orange", "blue", "green"), lwd=2, pch=19, cex=0.6
)
par(mfcol=c(1, 1))
}
simGameFull <- function(useList, gameName, nSims=2000,
nDealSim=c(1000, 2000, 4000, 8000, 16000, 24000, 32000, 40000),
nDealGraph=c(4000, 32000)
) {
simGraph <- 4 * match(nDealGraph, nDealSim) - 3
if (length(complete.cases(simGraph)) != 2) {
stop("Error with simGameFull; need exactly *TWO* nDealGraph that are subset of nDealSim")
}
simOut <- matrix(data=0, nrow=4*length(nDealSim), ncol=nSims+2) # nSims trials, plus nPlay and nHand
curRow <- 1
for (nUse in nDealSim) {
simOut[curRow:(curRow+3), 1] <- c(1, 3, 5, 10)
simOut[curRow:(curRow+3), 2] <- rep(nUse, 4)
simOut[curRow, -(1:2)] <- sim_NPlay(keyFrame=useList$game_01Play$dfOutcome,
useName=gameName, nPlay=1, nHands=nUse, nSim=nSims
)
simOut[curRow+1, -(1:2)] <- sim_NPlay(keyFrame=useList$game_03Play$dfOutcome,
useName=gameName, nPlay=3, nHands=nUse, nSim=nSims
)
simOut[curRow+2, -(1:2)] <- sim_NPlay(keyFrame=useList$game_05Play$dfOutcome,
useName=gameName, nPlay=5, nHands=nUse, nSim=nSims
)
simOut[curRow+3, -(1:2)] <- sim_NPlay(keyFrame=useList$game_10Play$out10Play,
useName=gameName, nPlay=10, nHands=nUse, nSim=nSims
)
curRow <- curRow + 4
}
simPct <- apply(simOut, 1, FUN=function(x) { c(x[1], x[2], sort(x[-(1:2)]/x[1]/x[2])) } )
# Graph the game outputs
graphGameFull(simPct=simPct, simGraph=simGraph, gName=gameName)
# Return the simOut and simPct object
list(simOut=simOut, simPct=simPct)
}The function is run for JB 95, BP 75, and DDB 96 (1/3/5/10 play), each using 2,000 trials of 1k, 2k, 4k, 8k, 16k, 24k, 32k, 40k deals:
# Run for JB 95
startTime <- proc.time()
jb95SimGameFull <- simGameFull(useList=jb95GameData, gameName="JB 95")##
## Mean return per hand: 0.9844978 with total variance: 19.49537
## Mean return per hand: 98.697% with total variance (sd as % of total bet): 21,485 ( 14.66% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1630 -0.1290 -0.1081 -0.0750 -0.0355 0.0080 0.0531 0.0970 0.8041
##
## Mean return per hand: 0.9844976 with total variance: 70.16407
## Mean return per hand: 98.515% with total variance (sd as % of total bet): 74,391 ( 9.09% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1373 -0.1047 -0.0877 -0.0610 -0.0323 0.0007 0.0422 0.2124 0.2923
##
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.775% with total variance (sd as % of total bet): 177,990 ( 8.44% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1160 -0.0930 -0.0790 -0.0566 -0.0294 0.0040 0.0939 0.1376 0.2275
##
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.415% with total variance (sd as % of total bet): 348,009 ( 5.9% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1092 -0.0854 -0.0739 -0.0533 -0.0253 0.0112 0.0526 0.0780 0.1403
##
## Mean return per hand: 0.9844978 with total variance: 19.49537
## Mean return per hand: 98.277% with total variance (sd as % of total bet): 38,699 ( 9.84% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1270 -0.0995 -0.0860 -0.0645 -0.0355 -0.0040 0.0330 0.0797 0.4045
##
## Mean return per hand: 0.9844976 with total variance: 70.16407
## Mean return per hand: 98.402% with total variance (sd as % of total bet): 144,160 ( 6.33% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1018 -0.0820 -0.0692 -0.0529 -0.0305 -0.0035 0.0719 0.1121 0.2298
##
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.514% with total variance (sd as % of total bet): 279,230 ( 5.28% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0936 -0.0764 -0.0655 -0.0489 -0.0257 0.0066 0.0533 0.0714 0.1362
##
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.586% with total variance (sd as % of total bet): 953,479 ( 4.88% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0821 -0.0664 -0.0582 -0.0428 -0.0210 0.0063 0.0342 0.0518 0.1016
##
## Mean return per hand: 0.9844978 with total variance: 19.49537
## Mean return per hand: 98.461% with total variance (sd as % of total bet): 73,851 ( 6.79% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1000 -0.0810 -0.0710 -0.0518 -0.0325 -0.0065 0.0438 0.1580 0.2055
##
## Mean return per hand: 0.9844976 with total variance: 70.16407
## Mean return per hand: 98.352% with total variance (sd as % of total bet): 266,656 ( 4.3% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0846 -0.0668 -0.0593 -0.0448 -0.0268 0.0027 0.0419 0.0583 0.1288
##
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.449% with total variance (sd as % of total bet): 534,335 ( 3.65% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0730 -0.0612 -0.0524 -0.0406 -0.0221 0.0019 0.0273 0.0487 0.1246
##
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.338% with total variance (sd as % of total bet): 1,345,000 ( 2.9% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0675 -0.0549 -0.0495 -0.0347 -0.0190 -0.0018 0.0183 0.0307 0.0519
##
## Mean return per hand: 0.9844978 with total variance: 19.49537
## Mean return per hand: 98.297% with total variance (sd as % of total bet): 146,817 ( 4.79% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0814 -0.0678 -0.0600 -0.0462 -0.0299 -0.0095 0.0598 0.0780 0.1524
##
## Mean return per hand: 0.9844976 with total variance: 70.16407
## Mean return per hand: 98.5% with total variance (sd as % of total bet): 589,350 ( 3.2% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0651 -0.0555 -0.0491 -0.0379 -0.0206 0.0011 0.0257 0.0444 0.0920
##
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.385% with total variance (sd as % of total bet): 1,081,253 ( 2.6% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0592 -0.0512 -0.0452 -0.0337 -0.0198 -0.0028 0.0158 0.0298 0.0722
##
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.349% with total variance (sd as % of total bet): 3,080,404 ( 2.19% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0552 -0.0469 -0.0414 -0.0303 -0.0184 -0.0054 0.0083 0.0163 0.0697
##
## Mean return per hand: 0.9844978 with total variance: 19.49537
## Mean return per hand: 98.315% with total variance (sd as % of total bet): 303,032 ( 3.44% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0694 -0.0570 -0.0517 -0.0404 -0.0271 0.0042 0.0292 0.0470 0.0857
##
## Mean return per hand: 0.9844976 with total variance: 70.16407
## Mean return per hand: 98.424% with total variance (sd as % of total bet): 1,050,588 ( 2.14% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0557 -0.0463 -0.0412 -0.0312 -0.0179 -0.0033 0.0123 0.0239 0.0404
##
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.409% with total variance (sd as % of total bet): 2,183,079 ( 1.85% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0510 -0.0428 -0.0374 -0.0289 -0.0178 -0.0050 0.0075 0.0163 0.0366
##
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.446% with total variance (sd as % of total bet): 5,848,164 ( 1.51% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0440 -0.0370 -0.0327 -0.0258 -0.0169 -0.0076 0.0020 0.0098 0.0345
##
## Mean return per hand: 0.9844978 with total variance: 19.49537
## Mean return per hand: 98.401% with total variance (sd as % of total bet): 458,985 ( 2.82% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0609 -0.0518 -0.0471 -0.0380 -0.0216 0.0015 0.0229 0.0367 0.0641
##
## Mean return per hand: 0.9844976 with total variance: 70.16407
## Mean return per hand: 98.527% with total variance (sd as % of total bet): 1,630,388 ( 1.77% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0484 -0.0415 -0.0365 -0.0276 -0.0159 -0.0040 0.0086 0.0165 0.0315
##
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.451% with total variance (sd as % of total bet): 3,142,957 ( 1.48% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0438 -0.0372 -0.0332 -0.0255 -0.0171 -0.0071 0.0035 0.0111 0.0274
##
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.422% with total variance (sd as % of total bet): 8,396,400 ( 1.21% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0389 -0.0332 -0.0301 -0.0239 -0.0167 -0.0092 -0.0003 0.0065 0.0197
##
## Mean return per hand: 0.9844978 with total variance: 19.49537
## Mean return per hand: 98.433% with total variance (sd as % of total bet): 596,487 ( 2.41% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0554 -0.0488 -0.0438 -0.0340 -0.0189 -0.0018 0.0166 0.0302 0.0509
##
## Mean return per hand: 0.9844976 with total variance: 70.16407
## Mean return per hand: 98.453% with total variance (sd as % of total bet): 2,277,007 ( 1.57% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0461 -0.0379 -0.0347 -0.0269 -0.0171 -0.0055 0.0053 0.0129 0.0265
##
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.426% with total variance (sd as % of total bet): 4,381,243 ( 1.31% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0411 -0.0345 -0.0311 -0.0250 -0.0168 -0.0082 0.0009 0.0085 0.0203
##
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.446% with total variance (sd as % of total bet): 11,950,050 ( 1.08% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0359 -0.0311 -0.0284 -0.0229 -0.0164 -0.0098 -0.0022 0.0044 0.0166
##
## Mean return per hand: 0.9844978 with total variance: 19.49537
## Mean return per hand: 98.438% with total variance (sd as % of total bet): 795,569 ( 2.23% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0544 -0.0466 -0.0417 -0.0326 -0.0181 -0.0027 0.0148 0.0260 0.0484
##
## Mean return per hand: 0.9844976 with total variance: 70.16407
## Mean return per hand: 98.49% with total variance (sd as % of total bet): 2,860,423 ( 1.41% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0433 -0.0363 -0.0325 -0.0250 -0.0158 -0.0068 0.0032 0.0106 0.0240
##
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.416% with total variance (sd as % of total bet): 5,296,307 ( 1.15% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0395 -0.0330 -0.0299 -0.0242 -0.0165 -0.0089 -0.0010 0.0042 0.0154
##
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.472% with total variance (sd as % of total bet): 15,665,331 ( 0.99% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0342 -0.0295 -0.0266 -0.0218 -0.0160 -0.0102 -0.0033 0.0024 0.0148
proc.time() - startTime## user system elapsed
## 77.38 23.87 101.37# Run for BP 75
startTime <- proc.time()
bp75SimGameFull <- simGameFull(useList=bp75GameData, gameName="BP 75")##
## Mean return per hand: 0.9801482 with total variance: 20.75481
## Mean return per hand: 98.11% with total variance (sd as % of total bet): 22,125 ( 14.87% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.181 -0.141 -0.124 -0.087 -0.041 0.008 0.065 0.110 0.773
##
## Mean return per hand: 0.980147 with total variance: 74.74454
## Mean return per hand: 97.775% with total variance (sd as % of total bet): 74,536 ( 9.1% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1370 -0.1147 -0.1007 -0.0743 -0.0403 -0.0026 0.0498 0.2017 0.2917
##
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 97.781% with total variance (sd as % of total bet): 124,857 ( 7.07% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1338 -0.1060 -0.0924 -0.0662 -0.0359 0.0018 0.0826 0.1222 0.1989
##
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 98.011% with total variance (sd as % of total bet): 414,855 ( 6.44% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1141 -0.0939 -0.0813 -0.0592 -0.0314 0.0087 0.0486 0.0826 0.1443
##
## Mean return per hand: 0.9801482 with total variance: 20.75481
## Mean return per hand: 98.349% with total variance (sd as % of total bet): 43,611 ( 10.44% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1365 -0.1120 -0.0976 -0.0710 -0.0368 0.0005 0.0516 0.2530 0.4050
##
## Mean return per hand: 0.980147 with total variance: 74.74454
## Mean return per hand: 97.789% with total variance (sd as % of total bet): 140,032 ( 6.24% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1133 -0.0927 -0.0817 -0.0605 -0.0357 -0.0042 0.0645 0.1033 0.1950
##
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 98.071% with total variance (sd as % of total bet): 284,082 ( 5.33% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1041 -0.0828 -0.0725 -0.0539 -0.0310 0.0050 0.0504 0.0761 0.1501
##
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 98.019% with total variance (sd as % of total bet): 808,576 ( 4.5% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0938 -0.0754 -0.0670 -0.0493 -0.0264 0.0028 0.0321 0.0502 0.0986
##
## Mean return per hand: 0.9801482 with total variance: 20.75481
## Mean return per hand: 98.052% with total variance (sd as % of total bet): 84,922 ( 7.29% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1140 -0.0925 -0.0815 -0.0610 -0.0371 -0.0069 0.0556 0.1605 0.2228
##
## Mean return per hand: 0.980147 with total variance: 74.74454
## Mean return per hand: 97.91% with total variance (sd as % of total bet): 295,144 ( 4.53% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0907 -0.0755 -0.0667 -0.0515 -0.0310 -0.0008 0.0398 0.0640 0.1360
##
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 97.879% with total variance (sd as % of total bet): 553,038 ( 3.72% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0835 -0.0687 -0.0610 -0.0461 -0.0272 -0.0011 0.0238 0.0401 0.0875
##
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 98.094% with total variance (sd as % of total bet): 1,696,421 ( 3.26% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0767 -0.0606 -0.0531 -0.0401 -0.0232 -0.0022 0.0172 0.0321 0.0612
##
## Mean return per hand: 0.9801482 with total variance: 20.75481
## Mean return per hand: 98.145% with total variance (sd as % of total bet): 166,421 ( 5.1% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0900 -0.0753 -0.0675 -0.0522 -0.0326 -0.0023 0.0621 0.0804 0.1465
##
## Mean return per hand: 0.980147 with total variance: 74.74454
## Mean return per hand: 97.921% with total variance (sd as % of total bet): 580,598 ( 3.17% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0733 -0.0627 -0.0565 -0.0429 -0.0259 -0.0036 0.0199 0.0382 0.0762
##
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 97.94% with total variance (sd as % of total bet): 1,091,965 ( 2.61% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0677 -0.0586 -0.0509 -0.0384 -0.0238 -0.0063 0.0121 0.0253 0.0595
##
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 97.963% with total variance (sd as % of total bet): 3,061,439 ( 2.19% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0618 -0.0505 -0.0449 -0.0344 -0.0222 -0.0090 0.0036 0.0125 0.0601
##
## Mean return per hand: 0.9801482 with total variance: 20.75481
## Mean return per hand: 98.07% with total variance (sd as % of total bet): 335,930 ( 3.62% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0781 -0.0648 -0.0571 -0.0455 -0.0282 0.0031 0.0279 0.0504 0.0850
##
## Mean return per hand: 0.980147 with total variance: 74.74454
## Mean return per hand: 97.983% with total variance (sd as % of total bet): 1,169,491 ( 2.25% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0624 -0.0532 -0.0469 -0.0358 -0.0228 -0.0068 0.0101 0.0213 0.0384
##
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 98.079% with total variance (sd as % of total bet): 2,376,711 ( 1.93% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0569 -0.0475 -0.0416 -0.0321 -0.0209 -0.0090 0.0048 0.0152 0.0382
##
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 97.982% with total variance (sd as % of total bet): 6,071,057 ( 1.54% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0506 -0.0428 -0.0381 -0.0304 -0.0216 -0.0120 -0.0018 0.0055 0.0315
##
## Mean return per hand: 0.9801482 with total variance: 20.75481
## Mean return per hand: 97.987% with total variance (sd as % of total bet): 477,539 ( 2.88% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0688 -0.0575 -0.0519 -0.0416 -0.0254 -0.0031 0.0192 0.0326 0.0650
##
## Mean return per hand: 0.980147 with total variance: 74.74454
## Mean return per hand: 97.946% with total variance (sd as % of total bet): 1,793,129 ( 1.86% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0556 -0.0479 -0.0435 -0.0340 -0.0224 -0.0084 0.0031 0.0113 0.0309
##
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 98.025% with total variance (sd as % of total bet): 3,554,360 ( 1.57% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0497 -0.0430 -0.0383 -0.0308 -0.0215 -0.0099 0.0010 0.0079 0.0224
##
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 98.067% with total variance (sd as % of total bet): 10,028,744 ( 1.32% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0453 -0.0386 -0.0346 -0.0283 -0.0204 -0.0117 -0.0028 0.0032 0.0213
##
## Mean return per hand: 0.9801482 with total variance: 20.75481
## Mean return per hand: 98.101% with total variance (sd as % of total bet): 657,849 ( 2.53% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0631 -0.0538 -0.0488 -0.0380 -0.0219 -0.0029 0.0157 0.0259 0.0495
##
## Mean return per hand: 0.980147 with total variance: 74.74454
## Mean return per hand: 97.976% with total variance (sd as % of total bet): 2,341,528 ( 1.59% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0525 -0.0448 -0.0399 -0.0317 -0.0211 -0.0100 0.0002 0.0071 0.0207
##
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 98.037% with total variance (sd as % of total bet): 4,570,808 ( 1.34% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0451 -0.0395 -0.0358 -0.0286 -0.0210 -0.0120 -0.0026 0.0039 0.0189
##
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 98.013% with total variance (sd as % of total bet): 12,177,831 ( 1.09% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0414 -0.0361 -0.0329 -0.0274 -0.0206 -0.0136 -0.0062 -0.0011 0.0119
##
## Mean return per hand: 0.9801482 with total variance: 20.75481
## Mean return per hand: 98.007% with total variance (sd as % of total bet): 855,820 ( 2.31% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0606 -0.0520 -0.0474 -0.0370 -0.0224 -0.0063 0.0107 0.0226 0.0443
##
## Mean return per hand: 0.980147 with total variance: 74.74454
## Mean return per hand: 98.039% with total variance (sd as % of total bet): 3,009,484 ( 1.45% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0484 -0.0414 -0.0369 -0.0299 -0.0209 -0.0110 -0.0007 0.0056 0.0202
##
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 98.026% with total variance (sd as % of total bet): 5,852,070 ( 1.21% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0438 -0.0383 -0.0350 -0.0280 -0.0202 -0.0124 -0.0044 0.0016 0.0128
##
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 97.994% with total variance (sd as % of total bet): 14,897,629 ( 0.96% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0396 -0.0348 -0.0316 -0.0266 -0.0210 -0.0142 -0.0076 -0.0036 0.0071
proc.time() - startTime## user system elapsed
## 77.59 24.96 102.93# Run for DDB 96
startTime <- proc.time()
ddb96SimGameFull <- simGameFull(useList=ddb96GameData, gameName="DDB 96")##
## Mean return per hand: 0.9898074 with total variance: 41.98469
## Mean return per hand: 98.588% with total variance (sd as % of total bet): 42,694 ( 20.66% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.2710 -0.2260 -0.2000 -0.1440 -0.0640 0.0520 0.2161 0.3880 0.7852
##
## Mean return per hand: 0.989809 with total variance: 154.8178
## Mean return per hand: 99.289% with total variance (sd as % of total bet): 146,954 ( 12.78% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.2097 -0.1697 -0.1448 -0.0973 -0.0290 0.0567 0.1545 0.2234 0.4067
##
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 98.906% with total variance (sd as % of total bet): 307,036 ( 11.08% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1818 -0.1524 -0.1316 -0.0882 -0.0281 0.0447 0.1212 0.1962 0.3368
##
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.963% with total variance (sd as % of total bet): 937,444 ( 9.68% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1619 -0.1287 -0.1096 -0.0713 -0.0261 0.0357 0.0995 0.1409 0.3061
##
## Mean return per hand: 0.9898074 with total variance: 41.98469
## Mean return per hand: 99.02% with total variance (sd as % of total bet): 84,054 ( 14.5% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.2225 -0.1850 -0.1595 -0.1095 -0.0395 0.0561 0.1751 0.2890 0.4640
##
## Mean return per hand: 0.989809 with total variance: 154.8178
## Mean return per hand: 99.129% with total variance (sd as % of total bet): 310,069 ( 9.28% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1723 -0.1329 -0.1135 -0.0747 -0.0235 0.0423 0.1212 0.1669 0.2573
##
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 99.122% with total variance (sd as % of total bet): 602,022 ( 7.76% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1441 -0.1162 -0.0993 -0.0654 -0.0180 0.0358 0.0945 0.1291 0.2091
##
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.867% with total variance (sd as % of total bet): 1,586,061 ( 6.3% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1270 -0.0978 -0.0818 -0.0536 -0.0189 0.0245 0.0696 0.0970 0.1878
##
## Mean return per hand: 0.9898074 with total variance: 41.98469
## Mean return per hand: 98.814% with total variance (sd as % of total bet): 166,471 ( 10.2% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1835 -0.1433 -0.1240 -0.0836 -0.0295 0.0408 0.1273 0.1775 0.3036
##
## Mean return per hand: 0.989809 with total variance: 154.8178
## Mean return per hand: 98.785% with total variance (sd as % of total bet): 647,354 ( 6.7% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1359 -0.1054 -0.0896 -0.0597 -0.0204 0.0266 0.0789 0.1086 0.1748
##
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 98.941% with total variance (sd as % of total bet): 1,275,093 ( 5.65% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1126 -0.0918 -0.0768 -0.0508 -0.0169 0.0235 0.0634 0.0872 0.1547
##
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.976% with total variance (sd as % of total bet): 3,297,321 ( 4.54% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0925 -0.0745 -0.0614 -0.0417 -0.0148 0.0137 0.0450 0.0704 0.1199
##
## Mean return per hand: 0.9898074 with total variance: 41.98469
## Mean return per hand: 99.081% with total variance (sd as % of total bet): 340,123 ( 7.29% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1336 -0.1120 -0.0959 -0.0626 -0.0173 0.0354 0.0898 0.1200 0.1948
##
## Mean return per hand: 0.989809 with total variance: 154.8178
## Mean return per hand: 98.85% with total variance (sd as % of total bet): 1,242,232 ( 4.64% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1000 -0.0778 -0.0670 -0.0439 -0.0162 0.0172 0.0474 0.0713 0.1217
##
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 99.023% with total variance (sd as % of total bet): 2,524,338 ( 3.97% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0932 -0.0694 -0.0586 -0.0380 -0.0122 0.0151 0.0422 0.0568 0.0980
##
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.987% with total variance (sd as % of total bet): 7,258,414 ( 3.37% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0764 -0.0589 -0.0498 -0.0323 -0.0129 0.0081 0.0307 0.0507 0.0921
##
## Mean return per hand: 0.9898074 with total variance: 41.98469
## Mean return per hand: 99.021% with total variance (sd as % of total bet): 657,509 ( 5.07% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1028 -0.0837 -0.0714 -0.0452 -0.0152 0.0206 0.0585 0.0828 0.1257
##
## Mean return per hand: 0.989809 with total variance: 154.8178
## Mean return per hand: 98.923% with total variance (sd as % of total bet): 2,485,878 ( 3.28% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0771 -0.0607 -0.0514 -0.0337 -0.0134 0.0084 0.0329 0.0448 0.0783
##
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 98.882% with total variance (sd as % of total bet): 4,912,885 ( 2.77% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0713 -0.0543 -0.0465 -0.0301 -0.0123 0.0063 0.0252 0.0355 0.0563
##
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.941% with total variance (sd as % of total bet): 14,498,714 ( 2.38% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0575 -0.0459 -0.0404 -0.0268 -0.0121 0.0036 0.0187 0.0298 0.0581
##
## Mean return per hand: 0.9898074 with total variance: 41.98469
## Mean return per hand: 98.938% with total variance (sd as % of total bet): 1,051,209 ( 4.27% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0965 -0.0753 -0.0630 -0.0407 -0.0138 0.0161 0.0433 0.0633 0.1045
##
## Mean return per hand: 0.989809 with total variance: 154.8178
## Mean return per hand: 98.976% with total variance (sd as % of total bet): 3,389,110 ( 2.56% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0656 -0.0506 -0.0420 -0.0279 -0.0116 0.0060 0.0219 0.0341 0.0577
##
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 98.99% with total variance (sd as % of total bet): 7,702,623 ( 2.31% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0564 -0.0463 -0.0396 -0.0264 -0.0109 0.0049 0.0195 0.0291 0.0485
##
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.98% with total variance (sd as % of total bet): 20,762,232 ( 1.9% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0501 -0.0390 -0.0325 -0.0228 -0.0117 0.0014 0.0144 0.0239 0.0419
##
## Mean return per hand: 0.9898074 with total variance: 41.98469
## Mean return per hand: 99% with total variance (sd as % of total bet): 1,344,528 ( 3.62% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0814 -0.0642 -0.0535 -0.0361 -0.0134 0.0131 0.0377 0.0550 0.0841
##
## Mean return per hand: 0.989809 with total variance: 154.8178
## Mean return per hand: 98.864% with total variance (sd as % of total bet): 4,949,282 ( 2.32% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0584 -0.0471 -0.0403 -0.0270 -0.0128 0.0028 0.0198 0.0294 0.0471
##
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 98.922% with total variance (sd as % of total bet): 9,072,346 ( 1.88% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0549 -0.0396 -0.0336 -0.0234 -0.0117 0.0012 0.0137 0.0206 0.0354
##
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.962% with total variance (sd as % of total bet): 25,857,997 ( 1.59% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0452 -0.0356 -0.0301 -0.0209 -0.0110 -0.0003 0.0097 0.0173 0.0307
##
## Mean return per hand: 0.9898074 with total variance: 41.98469
## Mean return per hand: 98.98% with total variance (sd as % of total bet): 1,610,529 ( 3.17% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0743 -0.0580 -0.0484 -0.0320 -0.0126 0.0092 0.0315 0.0449 0.0735
##
## Mean return per hand: 0.989809 with total variance: 154.8178
## Mean return per hand: 99.052% with total variance (sd as % of total bet): 6,292,565 ( 2.09% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0553 -0.0411 -0.0349 -0.0241 -0.0111 0.0048 0.0181 0.0270 0.0406
##
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 98.949% with total variance (sd as % of total bet): 12,024,002 ( 1.73% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0461 -0.0373 -0.0321 -0.0225 -0.0115 0.0008 0.0118 0.0191 0.0336
##
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.984% with total variance (sd as % of total bet): 36,147,438 ( 1.5% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0417 -0.0329 -0.0284 -0.0204 -0.0112 -0.0011 0.0095 0.0164 0.0299
proc.time() - startTime## user system elapsed
## 79.23 24.38 103.99Next, find the minimum achieved in 8,000 5-play deals (4,000 simulations each) for JB 95, BP 75, and DDB 96 (this has now been converted to a function - see further below):
Assess the differences in minimum and final outcomes, as well as “risk of ruin”, for JB 95 at 8k hands (this has now been converted to a function - see further below):
Next, find the minima for 8,000 10-play deals (4,000 simulations each) for JB 95, BP 75, and DDB 96 (this has been converted to a function - see further below):
Assess the differences in minimum and final outcomes, as well as “risk of ruin”, for JB 95 at 8k deals (this has been converted to a function - see further below):
A function is written to assess the minima and final base-units achieved in X hands of game Y:
plotMinFinal <- function(gm1Min, gm1Sum, gm1Name, gm2Min, gm2Sum, gm2Name) {
par(mfcol=c(1, 2))
# Plot the minima and final for gm1, ordered by lowest minimum
plot(x=(1:length(gm1Min))/length(gm1Min),
y=gm1Sum[order(gm1Min)],
xlab="Percentile", ylab="Base Per-Hand Units", main=paste("Units for", gm1Name),
col="green", pch=19, cex=0.25,
ylim=round(range(c(gm1Sum, gm1Min)), -3) + c(-500, 500)
)
points(x=(1:length(gm1Min))/length(gm1Min),
y=gm1Min[order(gm1Min)],
col="orange", pch=19, cex=0.5
)
abline(h=0, v=c(0.01, 0.05, 0.1, 0.25, 0.5), lty=2)
keyQuant <- quantile(gm1Min, c(0.01, 0.05, 0.1, 0.25, 0.5))
legend("topleft", col=c("green", "orange"), pch=19, cex=0.65,
legend=c("Final", paste0("Min ( ", paste(round(keyQuant,0), collapse=" "), " )"))
)
# Plot the minima and final for gm2, ordered by lowest minimum
plot(x=(1:length(gm2Min))/length(gm2Min),
y=gm2Sum[order(gm2Min)],
xlab="Percentile", ylab="Base Per-Hand Units", main=paste("Units for", gm2Name),
col="green", pch=19, cex=0.25,
ylim=round(range(c(gm2Sum, gm2Min)), -3) + c(-500, 500)
)
points(x=(1:length(gm2Min))/length(gm2Min),
y=gm2Min[order(gm2Min)],
col="orange", pch=19, cex=0.5
)
abline(h=0, v=c(0.01, 0.05, 0.1, 0.25, 0.5), lty=2)
keyQuant <- quantile(gm2Min, c(0.01, 0.05, 0.1, 0.25, 0.5))
legend("topleft", col=c("green", "orange"), pch=19, cex=0.65,
legend=c("Final", paste0("Min ( ", paste(round(keyQuant,0), collapse=" "), " )"))
)
par(mfcol=c(1, 1))
}The function is then applied for multiple scenarios, with the input data first run and cached:
jb95_05p_08k <- sim_NPlay(keyFrame=jb95GameData$game_05Play$dfOutcome, useName="JB 95",
nPlay=5, nHands=8000, nSims=4000, genCumMin=TRUE
)##
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.464% with total variance (sd as % of total bet): 1,086,549 ( 2.61% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0607 -0.0510 -0.0444 -0.0333 -0.0188 -0.0016 0.0174 0.0319 0.0722
bp75_05p_08k <- sim_NPlay(keyFrame=bp75GameData$game_05Play$dfOutcome, useName="BP 75",
nPlay=5, nHands=8000, nSims=4000, genCumMin=TRUE
)##
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 98.045% with total variance (sd as % of total bet): 1,127,555 ( 2.65% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0667 -0.0564 -0.0494 -0.0379 -0.0226 -0.0053 0.0134 0.0284 0.0651
ddb96_05p_08k <- sim_NPlay(keyFrame=ddb96GameData$game_05Play$dfOutcome, useName="DDB 96",
nPlay=5, nHands=8000, nSims=4000, genCumMin=TRUE
)##
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 98.949% with total variance (sd as % of total bet): 2,389,963 ( 3.86% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0886 -0.0687 -0.0571 -0.0376 -0.0136 0.0129 0.0389 0.0555 0.1001
jb95_05p_04k <- sim_NPlay(keyFrame=jb95GameData$game_05Play$dfOutcome, useName="JB 95",
nPlay=5, nHands=4000, nSims=4000, genCumMin=TRUE
)##
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.449% with total variance (sd as % of total bet): 537,349 ( 3.67% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0742 -0.0611 -0.0537 -0.0399 -0.0226 0.0029 0.0290 0.0461 0.1046
jb95_05p_02k <- sim_NPlay(keyFrame=jb95GameData$game_05Play$dfOutcome, useName="JB 95",
nPlay=5, nHands=2000, nSims=4000, genCumMin=TRUE
)##
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.574% with total variance (sd as % of total bet): 277,822 ( 5.27% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0909 -0.0750 -0.0652 -0.0471 -0.0263 0.0075 0.0519 0.0768 0.1475
jb95_10p_08k <- sim_NPlay(keyFrame=jb95GameData$game_10Play$out10Play, useName="JB 95",
nPlay=10, nHands=8000, nSims=4000, genCumMin=TRUE
)##
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.442% with total variance (sd as % of total bet): 2,877,689 ( 2.12% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0538 -0.0445 -0.0386 -0.0293 -0.0178 -0.0050 0.0084 0.0181 0.0658
bp75_10p_08k <- sim_NPlay(keyFrame=bp75GameData$game_10Play$out10Play, useName="BP 75",
nPlay=10, nHands=8000, nSims=4000, genCumMin=TRUE
)##
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 98.015% with total variance (sd as % of total bet): 3,276,298 ( 2.26% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0599 -0.0500 -0.0450 -0.0343 -0.0222 -0.0087 0.0057 0.0162 0.0647
ddb96_10p_08k <- sim_NPlay(keyFrame=ddb96GameData$game_10Play$out10Play, useName="DDB 96",
nPlay=10, nHands=8000, nSims=4000, genCumMin=TRUE
)##
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.796% with total variance (sd as % of total bet): 6,517,469 ( 3.19% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0763 -0.0586 -0.0496 -0.0339 -0.0148 0.0066 0.0283 0.0420 0.0797
jb95_10p_04k <- sim_NPlay(keyFrame=jb95GameData$game_10Play$out10Play, useName="JB 95",
nPlay=10, nHands=4000, nSims=4000, genCumMin=TRUE
)##
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.381% with total variance (sd as % of total bet): 1,336,088 ( 2.89% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0687 -0.0554 -0.0478 -0.0353 -0.0196 -0.0002 0.0185 0.0301 0.0626
jb95_10p_02k <- sim_NPlay(keyFrame=jb95GameData$game_10Play$out10Play, useName="JB 95",
nPlay=10, nHands=2000, nSims=4000, genCumMin=TRUE
)##
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.543% with total variance (sd as % of total bet): 875,297 ( 4.68% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0830 -0.0683 -0.0597 -0.0427 -0.0207 0.0055 0.0333 0.0541 0.0976
The function is run for:
- JB 95 5/10-play (each at 8k deals) vs. DDB 96 5/10-play (each at 8k deals)
- JB 95 5/10-play (each at 8k deals) vs. BP 75 5/10-play (each at 8k deals)
- JB 95 5-play (8k deals) vs. JB 95 5-play (once each as 4k/2k deals)
- JB 95 10-play (8k deals) vs. JB 95 10-play (once each as 4k/2k deals)
# JB 95 5-play (8k deals) vs. DDB 96 5-play (8k deals)
plotMinFinal(gm1Min=jb95_05p_08k$cumminNPlay, gm1Sum=jb95_05p_08k$sumsNPlay,
gm1Name="JB 95 5-play (8k deals)",
gm2Min=ddb96_05p_08k$cumminNPlay, gm2Sum=ddb96_05p_08k$sumsNPlay,
gm2Name="DDB 96 5-play (8k deals)"
)
# JB 95 5-play (8k deals) vs. BP 75 5-play (8k deals)
plotMinFinal(gm1Min=jb95_05p_08k$cumminNPlay, gm1Sum=jb95_05p_08k$sumsNPlay,
gm1Name="JB 95 5-play (8k deals)",
gm2Min=bp75_05p_08k$cumminNPlay, gm2Sum=bp75_05p_08k$sumsNPlay,
gm2Name="BP 75 5-play (8k deals)"
)
# JB 95 5-play (8k deals) vs. JB 95 5-play (4k deals)
plotMinFinal(gm1Min=jb95_05p_08k$cumminNPlay, gm1Sum=jb95_05p_08k$sumsNPlay,
gm1Name="JB 95 5-play (8k deals)",
gm2Min=jb95_05p_04k$cumminNPlay, gm2Sum=jb95_05p_04k$sumsNPlay,
gm2Name="JB 95 5-play (4k deals)"
)
# JB 95 5-play (8k deals) vs. JB 95 5-play (2k deals)
plotMinFinal(gm1Min=jb95_05p_08k$cumminNPlay, gm1Sum=jb95_05p_08k$sumsNPlay,
gm1Name="JB 95 5-play (8k deals)",
gm2Min=jb95_05p_02k$cumminNPlay, gm2Sum=jb95_05p_02k$sumsNPlay,
gm2Name="JB 95 5-play (2k deals)"
)
# JB 95 10-play (8k deals) vs. DDB 96 10-play (8k deals)
plotMinFinal(gm1Min=jb95_10p_08k$cumminNPlay, gm1Sum=jb95_10p_08k$sumsNPlay,
gm1Name="JB 95 10-play (8k deals)",
gm2Min=ddb96_10p_08k$cumminNPlay, gm2Sum=ddb96_10p_08k$sumsNPlay,
gm2Name="DDB 96 10-play (8k deals)"
)
# JB 95 10-play (8k deals) vs. JB 95 10-play (4k deals)
plotMinFinal(gm1Min=jb95_10p_08k$cumminNPlay, gm1Sum=jb95_10p_08k$sumsNPlay,
gm1Name="JB 95 10-play (8k deals)",
gm2Min=jb95_10p_04k$cumminNPlay, gm2Sum=jb95_10p_04k$sumsNPlay,
gm2Name="JB 95 10-play (4k deals)"
)
# JB 95 10-play (8k deals) vs. JB 95 10-play (2k deals)
plotMinFinal(gm1Min=jb95_10p_08k$cumminNPlay, gm1Sum=jb95_10p_08k$sumsNPlay,
gm1Name="JB 95 10-play (8k deals)",
gm2Min=jb95_10p_02k$cumminNPlay, gm2Sum=jb95_10p_02k$sumsNPlay,
gm2Name="JB 95 10-play (2k deals)"
)
A function is written to assess the “risk of ruin” as well as the differences in the final result and the minimum result for a particular game:
rrMinFinal <- function(gMin, gSum, gName, g2Min, g2Sum, g2Name) {
par(mfcol=c(1, 2))
# Game 1 Plots (Min vs. Final)
plot(x=gMin, y=gSum-gMin,
main=paste0("Final vs. Min (", gName, ")"),
xlab="Minimum", ylab="Final - Minimum",
pch=19, col=rgb(0, 0, 0.5, 0.25)
)
tmpSmooth <- loess.smooth(y=(gSum-gMin), x=gMin)
lines(tmpSmooth$x, tmpSmooth$y, col="red", lwd=2)
hist(pmin(1000, gSum-gMin),
col="light blue",
main=paste0("Final vs. Min (", gName, ")"),
xlab="Final - Min (capped at 1,000)"
)
# Game 2 Plots (Min vs. Final)
plot(x=g2Min, y=g2Sum-g2Min,
main=paste0("Final vs. Min (", g2Name, ")"),
xlab="Minimum", ylab="Final - Minimum",
pch=19, col=rgb(0, 0, 0.5, 0.25)
)
tmpSmooth <- loess.smooth(y=(g2Sum-g2Min), x=g2Min)
lines(tmpSmooth$x, tmpSmooth$y, col="red", lwd=2)
hist(pmin(1000, g2Sum-g2Min),
col="light blue",
main=paste0("Final vs. Min (", g2Name, ")"),
xlab="Final - Min (capped at 1,000)"
)
# Risk of Ruin Plots
xWorst <- floor(min(gMin)/50) * 50
xVals <- seq(xWorst, 0, by=50)
yVals <- sapply(xVals, FUN=function(x) { sum(gMin < x) })
plot(x=xVals, y=yVals/length(gMin),
pch=19, col="blue",
main=paste0("RR (", gName, ")"),
xlab="Units", ylab="Risk of Ruin"
)
rrX <- c(0.01, 0.05, 0.1, 0.25)
rrY <- quantile(gMin, rrX)
abline(h=rrX, v=rrY, lty=2, lwd=1,
col=c("red", "orange", "purple", "dark green")
)
legend("topleft", lty=2, cex=0.85,
legend=paste0(100*rrX, "%", " (", prettyNum(round(rrY, 0), big.mark=","),")"),
col=c("red", "orange", "purple", "dark green")
)
xWorst <- floor(min(g2Min)/50) * 50
xVals <- seq(xWorst, 0, by=50)
yVals <- sapply(xVals, FUN=function(x) { sum(g2Min < x) })
plot(x=xVals, y=yVals/length(g2Min),
pch=19, col="blue",
main=paste0("RR (", g2Name, ")"),
xlab="Units", ylab="Risk of Ruin"
)
rrX <- c(0.01, 0.05, 0.1, 0.25)
rrY <- quantile(g2Min, rrX)
abline(h=rrX, v=rrY, lty=2, lwd=1,
col=c("red", "orange", "purple", "dark green")
)
legend("topleft", lty=2, cex=0.85,
legend=paste0(100*rrX, "%", " (", prettyNum(round(rrY, 0), big.mark=","),")"),
col=c("red", "orange", "purple", "dark green")
)
par(mfcol=c(1, 1))
}The function is then applied for the following:
- JB 95 5-play (8k deals) and JB 95 5-play (2k deals)
- JB 95 10-play (8k deals) and JB 95 10-play (2k deals)
rrMinFinal(gMin=jb95_05p_08k$cumminNPlay, gSum=jb95_05p_08k$sumsNPlay,
gName="8k deals of 5-play JB 95",
g2Min=jb95_05p_02k$cumminNPlay, g2Sum=jb95_05p_02k$sumsNPlay,
g2Name="2k deals of 5-play JB 95"
)
rrMinFinal(gMin=jb95_10p_08k$cumminNPlay, gSum=jb95_10p_08k$sumsNPlay,
gName="8k deals of 10-play JB 95",
g2Min=jb95_10p_02k$cumminNPlay, g2Sum=jb95_10p_02k$sumsNPlay,
g2Name="2k deals of 10-play JB 95"
)
Next, the sim_NPlay function is adapted to explore the minimum results by number of hands, for example by simulating 24,000 deals and assessing the percentiles for total results at each of 1-24,000 hands. To keep file sizes reasonable, results are stored only once every 100 hands by default. The routine is run for the 10/5/3/1-play games for JB 95, BP 75, and DDB 96 at 24,000 hands. Results are cached:
jb95_05p_24k_fullmin <- sim_NPlay(keyFrame=jb95GameData$game_05Play$dfOutcome,
useName="JB 95", nPlay=5, nHands=24000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.483% with total variance (sd as % of total bet): 3,242,892 ( 1.5% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0441 -0.0372 -0.0331 -0.0257 -0.0163 -0.0068 0.0038 0.0117 0.0291
bp75_05p_24k_fullmin <- sim_NPlay(keyFrame=bp75GameData$game_05Play$dfOutcome,
useName="BP 75", nPlay=5, nHands=24000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 97.983% with total variance (sd as % of total bet): 3,584,825 ( 1.58% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0514 -0.0436 -0.0390 -0.0311 -0.0212 -0.0111 0.0001 0.0078 0.0242
ddb96_05p_24k_fullmin <- sim_NPlay(keyFrame=ddb96GameData$game_05Play$dfOutcome,
useName="DDB 96", nPlay=5, nHands=24000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 99.003% with total variance (sd as % of total bet): 7,124,294 ( 2.22% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0585 -0.0436 -0.0369 -0.0254 -0.0109 0.0038 0.0189 0.0292 0.0473
jb95_10p_24k_fullmin <- sim_NPlay(keyFrame=jb95GameData$game_10Play$out10Play,
useName="JB 95", nPlay=10, nHands=24000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.416% with total variance (sd as % of total bet): 8,775,328 ( 1.23% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0401 -0.0334 -0.0301 -0.0241 -0.0170 -0.0092 -0.0010 0.0061 0.0241
jb95_03p_24k_fullmin <- sim_NPlay(keyFrame=jb95GameData$game_03Play$dfOutcome,
useName="JB 95", nPlay=3, nHands=24000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean return per hand: 0.9844976 with total variance: 70.16407
## Mean return per hand: 98.468% with total variance (sd as % of total bet): 1,698,700 ( 1.81% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0494 -0.0413 -0.0369 -0.0281 -0.0172 -0.0047 0.0080 0.0170 0.0359
jb95_01p_24k_fullmin <- sim_NPlay(keyFrame=jb95GameData$game_01Play$dfOutcome,
useName="JB 95", nPlay=1, nHands=24000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean return per hand: 0.9844978 with total variance: 19.49537
## Mean return per hand: 98.41% with total variance (sd as % of total bet): 448,292 ( 2.79% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0589 -0.0515 -0.0465 -0.0370 -0.0214 0.0008 0.0220 0.0356 0.0691
bp75_10p_24k_fullmin <- sim_NPlay(keyFrame=bp75GameData$game_10Play$out10Play,
useName="BP 75", nPlay=10, nHands=24000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 98.039% with total variance (sd as % of total bet): 9,939,176 ( 1.31% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0442 -0.0385 -0.0351 -0.0283 -0.0211 -0.0125 -0.0036 0.0034 0.0220
bp75_03p_24k_fullmin <- sim_NPlay(keyFrame=bp75GameData$game_03Play$dfOutcome,
useName="BP 75", nPlay=3, nHands=24000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean return per hand: 0.980147 with total variance: 74.74454
## Mean return per hand: 98.03% with total variance (sd as % of total bet): 1,775,375 ( 1.85% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0556 -0.0472 -0.0420 -0.0330 -0.0212 -0.0085 0.0048 0.0131 0.0305
bp75_01p_24k_fullmin <- sim_NPlay(keyFrame=bp75GameData$game_01Play$dfOutcome,
useName="BP 75", nPlay=1, nHands=24000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean return per hand: 0.9801482 with total variance: 20.75481
## Mean return per hand: 98.058% with total variance (sd as % of total bet): 487,171 ( 2.91% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0688 -0.0581 -0.0520 -0.0407 -0.0244 -0.0023 0.0206 0.0340 0.0651
ddb96_10p_24k_fullmin <- sim_NPlay(keyFrame=ddb96GameData$game_10Play$out10Play,
useName="DDB 96", nPlay=10, nHands=24000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 99.039% with total variance (sd as % of total bet): 21,617,924 ( 1.94% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0484 -0.0388 -0.0330 -0.0233 -0.0110 0.0025 0.0157 0.0244 0.0405
ddb96_03p_24k_fullmin <- sim_NPlay(keyFrame=ddb96GameData$game_03Play$dfOutcome,
useName="DDB 96", nPlay=3, nHands=24000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean return per hand: 0.989809 with total variance: 154.8178
## Mean return per hand: 99.059% with total variance (sd as % of total bet): 3,812,166 ( 2.71% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0654 -0.0518 -0.0435 -0.0277 -0.0110 0.0074 0.0261 0.0372 0.0591
ddb96_01p_24k_fullmin <- sim_NPlay(keyFrame=ddb96GameData$game_01Play$dfOutcome,
useName="DDB 96", nPlay=1, nHands=24000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean return per hand: 0.9898074 with total variance: 41.98469
## Mean return per hand: 98.887% with total variance (sd as % of total bet): 1,006,346 ( 4.18% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0965 -0.0747 -0.0618 -0.0405 -0.0139 0.0148 0.0442 0.0618 0.1005
Next, the “risk of ruin” is assessed for varying starting amounts, with the results graphed. A function is written for easy re-application:
graphRRSurvival <- function(keyData, keyName, keyPct=c(1, 0.95, 0.8, 0.5),
keyCol=c("red", "orange", "purple", "blue", "grey", "green"),
keyBanks=seq(1000, 6000, by=1000)
) {
# Survival Curves for keyData
handNum <- 1
mtxData <- matrix(data=NA, nrow=length(keyCol), ncol=length(keyPct))
for (nBank in keyBanks) {
mtxSurv <- rowMeans(keyData > -nBank)
if (handNum == 1) {
plot(x=as.numeric(names(mtxSurv)), y=unname(mtxSurv),
main=paste0("Survival Curves (", keyName, ")"),
xlab="# Hands", ylab="Survival",
pch=19, col=keyCol[handNum], cex=0.5,
ylim=c(0, 1), xlim=c(0, max(as.integer(rownames(keyData))))
)
} else {
points(x=as.numeric(names(mtxSurv)), y=unname(mtxSurv),
pch=19, col=keyCol[handNum], cex=0.5
)
}
for (intCtr in seq_along(keyPct)) {
mtxData[handNum, intCtr] <-
as.numeric(names(mtxSurv)[sum(mtxSurv >= keyPct[intCtr])])
}
handNum <- handNum + 1
}
abline(h=keyPct, lty=2)
topRow <- paste("Units ( ",
paste(paste0(round(100*keyPct, 1), "%"), collapse=" | "),
" )"
)
appData <- apply(mtxData, 1,
FUN=function(x) {
paste(format(round(x/1000, 1), nsmall=1, width=5), collapse="k | ")
}
)
legend("bottomleft",
legend=c(topRow,
paste0(sprintf("%.2f", round(keyBanks/1000, 2)),
"k ( ", appData, "k )"
)
),
col=c("white", keyCol), cex=0.8, pch=19, pt.cex=1.2
)
}The JB 95 game is then assessed out to 24,000 deals for 10/5/3/1-play, assuming starting amounts equivalent to 1,000-6,000 units (increments of 1,000) in the 5-play game. A “unit” is the amount required to play a single line of the N-play game, so the total bet ber deal would be N * “unit”:
graphRRSurvival(keyData=jb95_10p_24k_fullmin$fullminNPlay,
keyName="JB 95 10-play", keyBanks=seq(2000, 12000, by=2000)
)
graphRRSurvival(keyData=jb95_05p_24k_fullmin$fullminNPlay,
keyName="JB 95 5-play", keyBanks=seq(1000, 6000, by=1000)
)
graphRRSurvival(keyData=jb95_03p_24k_fullmin$fullminNPlay,
keyName="JB 95 3-play", keyBanks=seq(600, 3600, by=600)
)
graphRRSurvival(keyData=jb95_01p_24k_fullmin$fullminNPlay,
keyName="JB 95 1-play", keyBanks=seq(200, 1200, by=200)
)
The BP 75 game is then assessed out to 24,000 deals for 10/5/3/1-play, assuming starting amounts equivalent to 1,000-6,000 units (increments of 1,000) in the 5-play game. A “unit” is the amount required to play a single line of the N-play game, so the total bet ber deal would be N * “unit”:
graphRRSurvival(keyData=bp75_10p_24k_fullmin$fullminNPlay,
keyName="BP 75 10-play", keyBanks=seq(2000, 12000, by=2000)
)
graphRRSurvival(keyData=bp75_05p_24k_fullmin$fullminNPlay,
keyName="BP 75 5-play", keyBanks=seq(1000, 6000, by=1000)
)
graphRRSurvival(keyData=bp75_03p_24k_fullmin$fullminNPlay,
keyName="BP 75 3-play", keyBanks=seq(600, 3600, by=600)
)
graphRRSurvival(keyData=bp75_01p_24k_fullmin$fullminNPlay,
keyName="BP 75 1-play", keyBanks=seq(200, 1200, by=200)
)
The DDB 96 game is then assessed out to 24,000 deals for 10/5/3/1-play, assuming starting amounts equivalent to 1,000-6,000 units (increments of 1,000) in the 5-play game. A “unit” is the amount required to play a single line of the N-play game, so the total bet ber deal would be N * “unit”:
graphRRSurvival(keyData=ddb96_10p_24k_fullmin$fullminNPlay,
keyName="DDB 96 10-play", keyBanks=seq(2000, 12000, by=2000)
)
graphRRSurvival(keyData=ddb96_05p_24k_fullmin$fullminNPlay,
keyName="DDB 96 5-play", keyBanks=seq(1000, 6000, by=1000)
)
graphRRSurvival(keyData=ddb96_03p_24k_fullmin$fullminNPlay,
keyName="DDB 96 3-play", keyBanks=seq(600, 3600, by=600)
)
graphRRSurvival(keyData=ddb96_01p_24k_fullmin$fullminNPlay,
keyName="DDB 96 1-play", keyBanks=seq(200, 1200, by=200)
)
The sim_NPlay function is adapted for the STP game, with a first pass at the results attempted:
jb95_05p_10k_fullmin_base <- sim_NPlay(keyFrame=jb95GameData$game_05Play$dfOutcome,
useName="JB 95", nPlay=5, nHands=10000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean base return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.449% with total variance (sd as % of total bet): 1,390,129 ( 2.36% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0580 -0.0478 -0.0419 -0.0316 -0.0182 -0.0029 0.0136 0.0252 0.0549
jb95_05p_10k_fullmin_stp <- sim_NPlay(keyFrame=jb95GameData$game_05Play$dfOutcome,
useName="JB 95", nPlay=5, nHands=10000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE, runSTP=TRUE
)##
## Mean base return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.635% with total variance (sd as % of total bet): 3,049,299 ( 2.91% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0622 -0.0519 -0.0444 -0.0321 -0.0172 -0.0006 0.0193 0.0381 0.0789
graphRRSurvival(keyData=jb95_05p_10k_fullmin_base$fullminNPlay,
keyName="JB 95 5-play", keyBanks=seq(1000, 6000, by=1000)
)
graphRRSurvival(keyData=jb95_05p_10k_fullmin_stp$fullminNPlay,
keyName="JB 95 5-play (STP)", keyBanks=seq(1000, 6000, by=1000)
)
Next, a sequence of very-low-pay games is created and assessed:
- JB 8-5 (regular and STP)
- JB 7-5 (regular and STP)
- BP 6-5 (regular and STP)
- DDB 9-5 (regular and STP)
- DDB 8-5 (regular and STP)
The results are cached for run-time improvement:
# Define the paytable and simulate the holds (JB 85)
startTime <- proc.time()
jb85hnd2Score <- data.frame(idx=gameIndex, val=c( -1,
799, 49, 7, 4, 3,
2, 1, 0, 0, 0,
0, -1, -1, 24, 24,
24, 24, 24, 24, 24,
24, 24, 24, 24, 24
)
)
jb85GameData <- genGame(hnd2Score=jb85hnd2Score, useGameName="JB 85")## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -1.0000 -1.0000 -0.6665 -1.0000 799.0000
##
## # A tibble: 10 × 2
## aScores ct
## <dbl> <int>
## 1 -1 2062860
## 2 0 337920
## 3 1 123552
## 4 2 54912
## 5 3 10200
## 6 4 5108
## 7 7 3744
## 8 24 624
## 9 49 36
## 10 799 4
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -0.9375 -0.8750 -0.6665 -0.6250 24.0000
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.9107 -0.8138 -0.8138 -0.6665 -0.6624 3.2040
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.8132 -0.7740 -0.6907 -0.6665 -0.6515 0.5045
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.7211 -0.7083 -0.7083 -0.6665 -0.5702 -0.5616
##
##
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6458 -0.5219 -0.1865 -0.0270 -0.0426 799.0000
##
## [1] 0.9729843
## [1] "Game JB 85: Return: 0.97298 and Variance on Deal: 1.903"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -74.5800 -29.2300 -15.6400 -12.8300 -0.6415 786.9000
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -76.88 -34.09 -24.09 -24.65 -13.77 11.44
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -115.300 -49.240 -29.500 -24.970 -8.499 841.000
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -121.6000 -55.0100 -39.4300 -40.5300 -23.5200 0.5264
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -184.90 -85.34 -56.59 -53.44 -28.31 783.60
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -190.1000 -93.8200 -69.5900 -70.5100 -44.8300 0.3851
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -309.80 -154.10 -114.00 -105.00 -68.54 812.50
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -317.800 -163.700 -125.700 -126.900 -88.560 3.241
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -517.9 -280.7 -223.2 -215.3 -162.9 739.7
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -525.300 -292.500 -238.900 -239.300 -183.700 -4.501
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -875.7 -527.9 -449.3 -435.2 -368.3 790.5
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -894.600 -541.300 -462.300 -462.300 -385.700 -6.652
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1270.0 -809.0 -702.0 -679.4 -597.0 1062.0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1273.000 -822.100 -717.500 -712.400 -616.100 -5.039
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1770.0 -1257.0 -1104.0 -1077.0 -959.0 989.9
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1770.00 -1271.00 -1123.00 -1111.00 -982.70 -54.98
## rndScore ct per
## 1 -1 899100 2.9
## 2 0 1158420 2.2
## 3 1 341496 7.6
## 4 2 124500 20.9
## 5 3 65148 39.9
## 6 4 4952 524.8
## 7 7 3744 694.2
## 8 17 752 3456.1
## 9 18 52 49980.0
## 10 19 132 19689.1
## 11 24 624 4165.0
## 12 49 36 72193.3
## 13 799 4 649740.0
## [1] 2598960 27
## [1] 270725 27
## [1] 22100 27
## [1] 1326 27
## [1] 52 27
## [1] 1 27
## idx 0 1 2 3 4 5 6 7 8 9 10 11
## [1,] 0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
## 12 13 14 15 16 17 18 19 20 21 22 23 24 25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1
##
## Summary of JB 85 starting with row sums
##
## 1 47 1081 16215 178365 1533939
## 2210 18052 9495 81971 18886 3845
##
## 1
## 134459
##
## [1] "JB 85: Overall EV and Mean"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6458 -0.5219 -0.1865 -0.0270 -0.0426 799.0000
## [1] "Overall Return: 0.972984"
##
## [1] "JB 85: Variances (Deal, Draw)"
## [1] "Deal Variance: 1.9031"
## [1] "Draw Variance Summary Statistics"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 2.437 3.392 17.420 4.402 13300.000
##
##
## This will assess the JB 85 means and variances
##
## 1 -1 2 14 15
## 2 799 3
## 3 49 4
## 4 7 5
## 5 4 6
## 6 3 7
## 7 2 8
## 8 1 9
## 9 0 10 11 12 13
## 10 24 16 17 18 19 20 21 22 23 24 25 26 27
## [1] 1270
## num [1:1270, 1:10] 0 0 0 0 33 ...
## rSum ct
## 1 1 6
## 2 47 34
## 3 1081 105
## 4 16215 95
## 5 178365 155
## 6 1533939 875
## chr [1:134459] "0-0-0-0-0-0-0-0-0-1" "0-0-0-0-0-0-0-0-0-1" ...
## chr [1:1270] "0-0-0-0-0-0-0-0-0-1" "0-0-0-1-0-0-0-0-0-0" ...
## int [1:134459] 1 1 1 1 1 1 1 1 1 1 ...
## num [1:1270(1d)] 624 3744 54912 123552 96 ...
## - attr(*, "dimnames")=List of 1
## ..$ : chr [1:1270] "1" "2" "3" "4" ...
## [1] 0.9729843
## [1] 17.4202
## scoreType occPer contRet occFreq
## 2 799 40170.000 0.019891 0.00002489
## 3 49 9288.000 0.005276 0.00010766
## 10 24 423.200 0.056709 0.00236289
## 4 7 86.850 0.080596 0.01151368
## 5 4 91.730 0.043606 0.01090156
## 6 3 89.010 0.033705 0.01123512
## 7 2 13.430 0.148925 0.07446275
## 8 1 7.734 0.129298 0.12929841
## 9 0 4.650 0.000000 0.21507064
## 1 -1 1.835 -0.545022 0.54502239
##
## Printed table suggests JB 85 mean return: 0.972984 and overall variance: 19.32047
##
## List of 1
## $ : int [1:10] 1 2 3 4 5 6 7 8 9 10
##
## 1
## 1270
## int [1:10, 1] 1 2 3 4 5 6 7 8 9 10
## [,1]
## [1,] 1
## [2,] 2
## [3,] 3
## [4,] 4
## [5,] 5
## [6,] 6
##
##
## Number of unique outcome types: 10
##
## Moving to assess the: 10 rows of outcomes
##
##
## Mean: 0.9729843 Variance: 19.32326
## List of 3
## $ : int [1:1000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1000] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1270
## int [1:1000, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3]
## [1,] 1 1 1
## [2,] 1 1 2
## [3,] 1 1 3
## [4,] 1 1 4
## [5,] 1 1 5
## [6,] 1 1 6
##
##
## Number of unique outcome types: 110
##
## Moving to assess the: 110 rows of outcomes
## num [1:1270, 1:3, 1:3] 0 0 0 0 0 ...
## num [1:1270, 1:3] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1270] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##
##
## Mean: 0.9729843 Variance: 69.38814
## List of 5
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1270
## int [1:100000, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 394
##
## Moving to assess the: 394 rows of outcomes
## num [1:1270, 1:95] 0.0 0.0 0.0 0.0 9.5e-06 ...
## num [1:1270] 0 0 0 0 0.000285 ...
## [1] 100
## num [1:1270, 1:545] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1270] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1270, 1:130] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1270] 0 0 0 0 0 ...
## [1] 300
##
##
## Mean: 0.9729843 Variance: 134.6775
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1270
## int [1:100000, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 394
##
## Moving to assess the: 394 rows of outcomes
## num [1:1270, 1:95] 0.0 0.0 0.0 0.0 9.5e-06 ...
## num [1:1270] 0 0 0 0 0.000285 ...
## [1] 100
## num [1:1270, 1:545] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1270] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1270, 1:130] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1270] 0 0 0 0 0 ...
## [1] 300
##
##
## Mean: 0.9729843 Variance: 364.508
##
## Mean base return per hand: 0.9729679 with total variance: 364.1599
## Mean return per hand: 97.295% with total variance (sd as % of total bet): 5,569,441 ( 1.47% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0540 -0.0480 -0.0437 -0.0365 -0.0288 -0.0187 -0.0100 -0.0018 0.0220
##
## Mean base return per hand: 0.9729817 with total variance: 134.6626
## Mean return per hand: 97.251% with total variance (sd as % of total bet): 2,099,216 ( 1.81% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0620 -0.0545 -0.0491 -0.0395 -0.0291 -0.0175 -0.0043 0.0046 0.0250
## num [1:1270, 1:10] 0 0 0 0 0.702 ...
## - attr(*, "dimnames")=List of 2
## ..$ : NULL
## ..$ : chr [1:10] "" "" "" "" ...
## [1] TRUE
## [1] TRUEproc.time() - startTime## user system elapsed
## 117.41 9.72 127.80# Define the paytable and simulate the holds (JB 75)
startTime <- proc.time()
jb75hnd2Score <- data.frame(idx=gameIndex, val=c( -1,
799, 49, 6, 4, 3,
2, 1, 0, 0, 0,
0, -1, -1, 24, 24,
24, 24, 24, 24, 24,
24, 24, 24, 24, 24
)
)
jb75GameData <- genGame(hnd2Score=jb75hnd2Score, useGameName="JB 75")## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.000 -1.000 -1.000 -0.668 -1.000 799.000
##
## # A tibble: 10 × 2
## aScores ct
## <dbl> <int>
## 1 -1 2062860
## 2 0 337920
## 3 1 123552
## 4 2 54912
## 5 3 10200
## 6 4 5108
## 7 6 3744
## 8 24 624
## 9 49 36
## 10 799 4
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -0.9375 -0.8750 -0.6680 -0.6250 24.0000
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.9107 -0.8138 -0.8138 -0.6680 -0.6624 3.1430
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.8141 -0.7749 -0.6916 -0.6680 -0.6524 0.4947
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.7225 -0.7097 -0.7097 -0.6680 -0.5716 -0.5631
##
##
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6472 -0.5235 -0.1967 -0.0385 -0.0426 799.0000
##
## [1] 0.9614721
## [1] "Game JB 75: Return: 0.96147 and Variance on Deal: 1.864"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -78.360 -34.690 -21.510 -18.590 -6.808 781.800
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -80.480 -38.770 -28.420 -28.600 -17.420 7.573
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -124.20 -59.91 -40.93 -36.47 -20.82 828.50
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -130.3000 -65.0200 -48.8900 -49.1700 -32.2300 -0.1967
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -203.80 -107.70 -79.82 -76.46 -51.56 760.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -208.0000 -114.2000 -89.0700 -89.4000 -63.7500 -0.3933
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -351.5 -199.2 -160.5 -151.0 -115.6 761.2
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -357.800 -206.300 -168.600 -167.900 -130.900 -3.043
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -603.1 -372.2 -315.9 -307.5 -256.0 645.9
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -609.70 -380.20 -324.70 -325.60 -270.10 -20.04
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1051.0 -710.7 -634.6 -619.5 -554.9 594.5
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1066.000 -720.700 -643.500 -639.600 -565.700 -6.847
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1547.0 -1094.0 -989.7 -967.3 -885.9 766.2
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1550.000 -1104.000 -1002.000 -990.800 -899.500 -5.501
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -2206.0 -1715.0 -1565.0 -1538.0 -1422.0 522.2
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -2206.00 -1724.00 -1579.00 -1561.00 -1437.00 -95.65
## rndScore ct per
## 1 -1 911328 2.9
## 2 0 1146192 2.3
## 3 1 465048 5.6
## 4 2 948 2741.5
## 5 3 65148 39.9
## 6 4 4952 524.8
## 7 6 3744 694.2
## 8 17 752 3456.1
## 9 18 52 49980.0
## 10 19 132 19689.1
## 11 24 624 4165.0
## 12 49 36 72193.3
## 13 799 4 649740.0
## [1] 2598960 27
## [1] 270725 27
## [1] 22100 27
## [1] 1326 27
## [1] 52 27
## [1] 1 27
## idx 0 1 2 3 4 5 6 7 8 9 10 11
## [1,] 0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
## 12 13 14 15 16 17 18 19 20 21 22 23 24 25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1
##
## Summary of JB 75 starting with row sums
##
## 1 47 1081 16215 178365 1533939
## 2210 18087 9505 81927 18885 3845
##
## 1
## 134459
##
## [1] "JB 75: Overall EV and Mean"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6472 -0.5235 -0.1967 -0.0385 -0.0426 799.0000
## [1] "Overall Return: 0.961472"
##
## [1] "JB 75: Variances (Deal, Draw)"
## [1] "Deal Variance: 1.8637"
## [1] "Draw Variance Summary Statistics"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 2.260 3.256 17.310 4.380 13300.000
##
##
## This will assess the JB 75 means and variances
##
## 1 -1 2 14 15
## 2 799 3
## 3 49 4
## 4 6 5
## 5 4 6
## 6 3 7
## 7 2 8
## 8 1 9
## 9 0 10 11 12 13
## 10 24 16 17 18 19 20 21 22 23 24 25 26 27
## [1] 1270
## num [1:1270, 1:10] 0 0 0 0 33 ...
## rSum ct
## 1 1 6
## 2 47 34
## 3 1081 105
## 4 16215 95
## 5 178365 155
## 6 1533939 875
## chr [1:134459] "0-0-0-0-0-0-0-0-0-1" "0-0-0-0-0-0-0-0-0-1" ...
## chr [1:1270] "0-0-0-0-0-0-0-0-0-1" "0-0-0-1-0-0-0-0-0-0" ...
## int [1:134459] 1 1 1 1 1 1 1 1 1 1 ...
## num [1:1270(1d)] 624 3744 54912 123552 96 ...
## - attr(*, "dimnames")=List of 1
## ..$ : chr [1:1270] "1" "2" "3" "4" ...
## [1] 0.9614721
## [1] 17.3082
## scoreType occPer contRet occFreq
## 2 799 40170.000 0.019889 0.00002489
## 3 49 9279.000 0.005281 0.00010777
## 10 24 423.300 0.056691 0.00236214
## 4 6 86.870 0.069065 0.01151088
## 5 4 91.710 0.043615 0.01090370
## 6 3 88.640 0.033845 0.01128179
## 7 2 13.440 0.148863 0.07443153
## 8 1 7.737 0.129254 0.12925441
## 9 0 4.649 0.000000 0.21509062
## 1 -1 1.835 -0.545032 0.54503227
##
## Printed table suggests JB 75 mean return: 0.961471 and overall variance: 19.17006
##
## List of 1
## $ : int [1:10] 1 2 3 4 5 6 7 8 9 10
##
## 1
## 1270
## int [1:10, 1] 1 2 3 4 5 6 7 8 9 10
## [,1]
## [1,] 1
## [2,] 2
## [3,] 3
## [4,] 4
## [5,] 5
## [6,] 6
##
##
## Number of unique outcome types: 10
##
## Moving to assess the: 10 rows of outcomes
##
##
## Mean: 0.9614721 Variance: 19.1719
## List of 3
## $ : int [1:1000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1000] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1270
## int [1:1000, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3]
## [1,] 1 1 1
## [2,] 1 1 2
## [3,] 1 1 3
## [4,] 1 1 4
## [5,] 1 1 5
## [6,] 1 1 6
##
##
## Number of unique outcome types: 105
##
## Moving to assess the: 105 rows of outcomes
## num [1:1270, 1:3, 1:3] 0 0 0 0 0 ...
## num [1:1270, 1:3] 0 0 0 0 0 ...
## num [1:1270] 0 0 0 0 0 ...
## [1] 100
##
##
## Mean: 0.9614721 Variance: 68.69794
## List of 5
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1270
## int [1:100000, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 377
##
## Moving to assess the: 377 rows of outcomes
## num [1:1270, 1:225] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1270] 0.00 0.00 1.47e-05 0.00 3.49e-07 ...
## [1] 100
## num [1:1270, 1:420] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1270] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1270, 1:150] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1270] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
##
##
## Mean: 0.9614721 Variance: 133.1336
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:100000] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1270
## int [1:100000, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 377
##
## Moving to assess the: 377 rows of outcomes
## num [1:1270, 1:225] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1270] 0.00 0.00 1.47e-05 0.00 3.49e-07 ...
## [1] 100
## num [1:1270, 1:420] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1270] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1270, 1:150] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1270] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
##
##
## Mean: 0.9614721 Variance: 359.4525
##
## Mean base return per hand: 0.9614556 with total variance: 359.104
## Mean return per hand: 96.145% with total variance (sd as % of total bet): 5,493,920 ( 1.46% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0653 -0.0593 -0.0550 -0.0480 -0.0402 -0.0304 -0.0216 -0.0138 0.0105
##
## Mean base return per hand: 0.9614682 with total variance: 133.1136
## Mean return per hand: 96.1% with total variance (sd as % of total bet): 2,073,370 ( 1.8% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0730 -0.0659 -0.0605 -0.0509 -0.0407 -0.0290 -0.0158 -0.0071 0.0138
## num [1:1270, 1:10] 0 0 0 0 0.702 ...
## - attr(*, "dimnames")=List of 2
## ..$ : NULL
## ..$ : chr [1:10] "" "" "" "" ...
## [1] TRUE
## [1] TRUEproc.time() - startTime## user system elapsed
## 108.01 9.87 118.26# Define the paytable and simulate the holds (BP 65)
startTime <- proc.time()
bp65hnd2Score <- data.frame(idx=gameIndex, val=c( -1,
799, 49, 5, 4, 3,
2, 1, 0, 0, 0,
0, -1, -1, 79, 79,
79, 39, 39, 39, 39,
24, 24, 24, 24, 24
)
)
bp65GameData <- genGame(hnd2Score=bp65hnd2Score, useGameName="BP 65")## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -1.0000 -1.0000 -0.6676 -1.0000 799.0000
##
## # A tibble: 12 × 2
## aScores ct
## <dbl> <int>
## 1 -1 2062860
## 2 0 337920
## 3 1 123552
## 4 2 54912
## 5 3 10200
## 6 4 5108
## 7 5 3744
## 8 24 432
## 9 39 144
## 10 49 36
## 11 79 48
## 12 799 4
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -0.9375 -0.8750 -0.6676 -0.6250 79.0000
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.9107 -0.8138 -0.8138 -0.6676 -0.6624 5.3270
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.8150 -0.7751 -0.6926 -0.6676 -0.6534 0.6196
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.7207 -0.7108 -0.7108 -0.6676 -0.5726 -0.5623
##
##
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6461 -0.5213 -0.2068 -0.0313 -0.0426 799.0000
##
## [1] 0.9686872
## [1] "Game BP 65: Return: 0.96869 and Variance on Deal: 2.044"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -73.780 -32.060 -18.760 -15.100 -3.151 785.500
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -76.110 -36.610 -26.350 -26.680 -15.540 9.516
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -121.40 -54.14 -35.05 -28.94 -12.17 833.40
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -128.100 -60.520 -43.950 -44.580 -27.110 0.506
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -194.80 -96.23 -67.84 -62.52 -36.01 775.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -195.1000 -103.8000 -78.8900 -79.2800 -52.7800 0.2417
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -340.40 -174.50 -131.90 -122.00 -83.02 786.70
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -340.400 -183.000 -144.900 -144.000 -105.000 2.319
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -551.4 -322.3 -260.9 -250.6 -195.5 694.8
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -553.900 -332.200 -276.300 -274.600 -216.100 -8.072
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -930.6 -605.3 -524.1 -505.4 -429.7 750.3
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -939.100 -618.800 -537.700 -531.500 -451.500 -7.027
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1386.0 -926.1 -813.1 -787.9 -693.9 942.2
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1424.000 -942.700 -826.800 -819.000 -715.000 -5.373
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1998.0 -1437.0 -1274.0 -1249.0 -1116.0 886.4
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1998.00 -1453.00 -1294.00 -1281.00 -1138.00 -82.87
## rndScore ct per
## 1 -1 911328 2.9
## 2 0 1146192 2.3
## 3 1 465048 5.6
## 4 2 948 2741.5
## 5 3 48252 53.9
## 6 4 17624 147.5
## 7 5 7968 326.2
## 8 17 752 3456.1
## 9 18 52 49980.0
## 10 19 132 19689.1
## 11 24 432 6016.1
## 12 39 144 18048.3
## 13 49 36 72193.3
## 14 79 48 54145.0
## 15 799 4 649740.0
## [1] 2598960 27
## [1] 270725 27
## [1] 22100 27
## [1] 1326 27
## [1] 52 27
## [1] 1 27
## idx 0 1 2 3 4 5 6 7 8 9 10 11
## [1,] 0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
## 12 13 14 15 16 17 18 19 20 21 22 23 24 25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1
##
## Summary of BP 65 starting with row sums
##
## 1 47 1081 16215 178365 1533939
## 2186 18087 9533 81915 18893 3845
##
## 1
## 134459
##
## [1] "BP 65: Overall EV and Mean"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6461 -0.5213 -0.2068 -0.0313 -0.0426 799.0000
## [1] "Overall Return: 0.968687"
##
## [1] "BP 65: Variances (Deal, Draw)"
## [1] "Deal Variance: 2.0442"
## [1] "Draw Variance Summary Statistics"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 2.214 3.140 18.610 5.778 13300.000
##
##
## This will assess the BP 65 means and variances
##
## 1 -1 2 14 15
## 2 799 3
## 3 49 4
## 4 5 5
## 5 4 6
## 6 3 7
## 7 2 8
## 8 1 9
## 9 0 10 11 12 13
## 10 79 16 17 18
## 11 39 19 20 21 22
## 12 24 23 24 25 26 27
## [1] 1648
## num [1:1648, 1:12] 0 0 0 0 0 0 0 0 0 33 ...
## rSum ct
## 1 1 8
## 2 47 34
## 3 1081 107
## 4 16215 95
## 5 178365 451
## 6 1533939 953
## chr [1:134459] "0-0-0-0-0-0-0-0-0-1-0-0" ...
## chr [1:1648] "0-0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-0-0-1-0" ...
## int [1:134459] 1 1 1 1 1 1 1 1 1 1 ...
## num [1:1648(1d)] 48 144 432 288 3456 ...
## - attr(*, "dimnames")=List of 1
## ..$ : chr [1:1648] "1" "2" "3" "4" ...
## [1] 0.9686872
## [1] 18.61045
## scoreType occPer contRet occFreq
## 2 799 40240.000 0.019858 0.00002485
## 10 79 4987.000 0.015840 0.00020050
## 3 49 9290.000 0.005274 0.00010764
## 11 39 1897.000 0.020563 0.00052725
## 12 24 610.100 0.039338 0.00163910
## 4 5 87.670 0.057035 0.01140691
## 5 4 91.750 0.043598 0.01089956
## 6 3 88.690 0.033825 0.01127493
## 7 2 13.420 0.149061 0.07453069
## 8 1 7.737 0.129254 0.12925390
## 9 0 4.647 0.000000 0.21517583
## 1 -1 1.835 -0.544959 0.54495884
##
## Printed table suggests BP 65 mean return: 0.968687 and overall variance: 20.65249
##
## List of 1
## $ : int [1:12] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1648
## int [1:12, 1] 1 2 3 4 5 6 7 8 9 10 ...
## [,1]
## [1,] 1
## [2,] 2
## [3,] 3
## [4,] 4
## [5,] 5
## [6,] 6
##
##
## Number of unique outcome types: 12
##
## Moving to assess the: 12 rows of outcomes
##
##
## Mean: 0.9686872 Variance: 20.65466
## List of 3
## $ : int [1:1728] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1728] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1728] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1648
## int [1:1728, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3]
## [1,] 1 1 1
## [2,] 1 1 2
## [3,] 1 1 3
## [4,] 1 1 4
## [5,] 1 1 5
## [6,] 1 1 6
##
##
## Number of unique outcome types: 189
##
## Moving to assess the: 189 rows of outcomes
## num [1:1648, 1:3, 1:6] 0 0 0 0 0 ...
## num [1:1648, 1:6] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##
##
## Mean: 0.9686872 Variance: 74.22922
## List of 5
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1648
## int [1:248832, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 711
##
## Moving to assess the: 711 rows of outcomes
## num [1:1648, 1:1140] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## num [1:1648, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1648, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
## num [1:1648, 1:320] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
## num [1:1648, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
## num [1:1648, 1:180] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
## num [1:1648, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
##
##
## Mean: 0.9686872 Variance: 144.1575
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:248832] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1648
## int [1:248832, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 711
##
## Moving to assess the: 711 rows of outcomes
## num [1:1648, 1:1140] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## num [1:1648, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1648, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
## num [1:1648, 1:320] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
## num [1:1648, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
## num [1:1648, 1:180] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
## num [1:1648, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
##
##
## Mean: 0.9686872 Variance: 390.5254
##
## Mean base return per hand: 0.9686707 with total variance: 390.1796
## Mean return per hand: 96.864% with total variance (sd as % of total bet): 5,944,448 ( 1.52% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0602 -0.0532 -0.0490 -0.0414 -0.0330 -0.0228 -0.0138 -0.0057 0.0188
##
## Mean base return per hand: 0.9686833 with total variance: 144.138
## Mean return per hand: 96.816% with total variance (sd as % of total bet): 2,269,576 ( 1.88% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0679 -0.0603 -0.0553 -0.0439 -0.0332 -0.0213 -0.0079 0.0008 0.0245
## num [1:1648, 1:12] 0 0 0 0 0 ...
## - attr(*, "dimnames")=List of 2
## ..$ : NULL
## ..$ : chr [1:12] "" "" "" "" ...
## [1] TRUE
## [1] TRUEproc.time() - startTime## user system elapsed
## 152.85 14.18 167.71# Define the paytable and simulate the holds (DDB 95)
startTime <- proc.time()
ddb95hnd2Score <- data.frame(idx=gameIndex, val=c( -1,
799, 49, 8, 4, 3,
2, 0, 0, 0, 0,
0, -1, -1, 399, 159,
159, 159, 159, 79, 79,
49, 49, 49, 49, 49
)
)
ddb95GameData <- genGame(hnd2Score=ddb95hnd2Score, useGameName="DDB 95")## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -1.0000 -1.0000 -0.7007 -1.0000 799.0000
##
## # A tibble: 11 × 2
## aScores ct
## <dbl> <int>
## 1 -1 2062860
## 2 0 461472
## 3 2 54912
## 4 3 10200
## 5 4 5108
## 6 8 3744
## 7 49 468
## 8 79 108
## 9 159 72
## 10 399 12
## 11 799 4
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -0.9375 -0.8750 -0.7007 -0.7500 219.0000
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.9337 -0.8367 -0.8367 -0.7007 -0.6854 11.2200
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.8501 -0.8094 -0.7277 -0.7007 -0.6885 0.8302
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.7493 -0.7476 -0.7450 -0.7007 -0.6095 -0.5763
##
##
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6788 -0.5428 -0.2668 -0.0213 -0.0426 799.0000
##
## [1] 0.9787294
## [1] "Game DDB 95: Return: 0.97873 and Variance on Deal: 4.789"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -84.160 -35.300 -18.780 -10.540 3.534 793.900
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -86.45 -42.57 -29.85 -30.51 -17.04 18.42
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -140.800 -58.980 -32.900 -18.140 2.836 854.900
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -151.4000 -68.6800 -47.0900 -48.9400 -26.5800 0.9119
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -226.60 -99.92 -60.32 -43.87 -11.93 833.20
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -227.00 -115.00 -81.15 -82.90 -46.91 2.13
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -381.30 -171.30 -106.30 -80.63 -23.69 1033.00
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -381.300 -190.300 -137.100 -138.900 -84.870 4.366
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -614.70 -296.40 -198.90 -173.20 -86.01 885.60
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -624.4000 -324.5000 -246.3000 -244.2000 -157.6000 -0.0123
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -992.9 -534.9 -383.8 -347.5 -206.4 1275.0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1006.000 -568.400 -441.500 -430.800 -290.400 1.503
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1380.0 -790.0 -584.9 -539.8 -333.8 1321.0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1392.00 -830.00 -646.10 -636.80 -451.80 -0.86
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -2122.0 -1154.0 -875.7 -849.9 -597.6 1695.0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -2137.000 -1213.000 -958.300 -954.100 -714.200 -5.543
## rndScore ct per
## 1 -1 951324 2.7
## 2 0 1359276 1.9
## 3 1 211968 12.3
## 4 2 948 2741.5
## 5 3 10236 253.9
## 6 4 42968 60.5
## 7 6 5760 451.2
## 8 7 6912 376.0
## 9 8 3456 752.0
## 10 11 1992 1304.7
## 11 12 2520 1031.3
## 12 17 752 3456.1
## 13 18 52 49980.0
## 14 19 132 19689.1
## 15 49 468 5553.3
## 16 99 108 24064.4
## 17 159 36 72193.3
## 18 220 36 72193.3
## 19 399 12 216580.0
## 20 799 4 649740.0
## [1] 2598960 27
## [1] 270725 27
## [1] 22100 27
## [1] 1326 27
## [1] 52 27
## [1] 1 27
## idx 0 1 2 3 4 5 6 7 8 9 10 11
## [1,] 0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
## 12 13 14 15 16 17 18 19 20 21 22 23 24 25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1
##
## Summary of DDB 95 starting with row sums
##
## 1 47 1081 16215 178365 1533939
## 2150 19722 9447 72794 27912 2434
##
## 1
## 134459
##
## [1] "DDB 95: Overall EV and Mean"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6788 -0.5428 -0.2668 -0.0213 -0.0426 799.0000
## [1] "Overall Return: 0.978729"
##
## [1] "DDB 95: Variances (Deal, Draw)"
## [1] "Deal Variance: 4.7887"
## [1] "Draw Variance Summary Statistics"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 5.033 8.414 37.380 19.970 13300.000
##
##
## This will assess the DDB 95 means and variances
##
## 1 -1 2 14 15
## 2 799 3
## 3 49 4 23 24 25 26 27
## 4 8 5
## 5 4 6
## 6 3 7
## 7 2 8
## 8 0 9 10 11 12 13
## 9 399 16
## 10 159 17 18 19 20
## 11 79 21 22
## [1] 1257
## num [1:1257, 1:11] 0 0 0 0 0 0 0 0 0 0 ...
## rSum ct
## 1 1 7
## 2 47 38
## 3 1081 112
## 4 16215 91
## 5 178365 513
## 6 1533939 496
## chr [1:134459] "0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-1-0-0" ...
## chr [1:1257] "0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-12-35-0" ...
## int [1:134459] 1 1 1 2 2 2 2 2 2 2 ...
## num [1:1257(1d)] 12 36 36 108 468 ...
## - attr(*, "dimnames")=List of 1
## ..$ : chr [1:1257] "1" "2" "3" "4" ...
## [1] 0.9787294
## [1] 37.37838
## scoreType occPer contRet occFreq
## 2 799 40070.000 0.019942 0.00002496
## 9 399 16230.000 0.024587 0.00006162
## 10 159 3157.000 0.050367 0.00031677
## 11 79 2601.000 0.030370 0.00038443
## 3 49 575.100 0.085200 0.00173877
## 4 8 92.010 0.086946 0.01086828
## 5 4 91.110 0.043904 0.01097590
## 6 3 77.270 0.038827 0.01294222
## 7 2 13.270 0.150681 0.07534037
## 8 0 2.983 0.000000 0.33525350
## 1 -1 1.811 -0.552093 0.55209319
##
## Printed table suggests DDB 95 mean return: 0.978731 and overall variance: 42.1674
##
## List of 1
## $ : int [1:11] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1257
## int [1:11, 1] 1 2 3 4 5 6 7 8 9 10 ...
## [,1]
## [1,] 1
## [2,] 2
## [3,] 3
## [4,] 4
## [5,] 5
## [6,] 6
##
##
## Number of unique outcome types: 11
##
## Moving to assess the: 11 rows of outcomes
##
##
## Mean: 0.9787294 Variance: 42.16708
## List of 3
## $ : int [1:1331] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1331] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1331] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1257
## int [1:1331, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3]
## [1,] 1 1 1
## [2,] 1 1 2
## [3,] 1 1 3
## [4,] 1 1 4
## [5,] 1 1 5
## [6,] 1 1 6
##
##
## Number of unique outcome types: 200
##
## Moving to assess the: 200 rows of outcomes
## num [1:1257, 1:3, 1:3] 0 0 0 0 0 ...
## num [1:1257, 1:3] 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 ...
## [1] 100
## num [1:1257, 1:3, 1] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1257, 1] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##
##
## Mean: 0.9787294 Variance: 155.2334
## List of 5
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1257
## int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 1041
##
## Moving to assess the: 1041 rows of outcomes
## num [1:1257, 1:200] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## num [1:1257, 1:240] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1257, 1:10] 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 ...
## [1] 300
## num [1:1257, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
## num [1:1257, 1:145] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
## num [1:1257, 1:360] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
## num [1:1257, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
## num [1:1257, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
## num [1:1257, 1:30] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 900
## num [1:1257, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
##
##
## Mean: 0.9787294 Variance: 306.6094
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1257
## int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 1041
##
## Moving to assess the: 1041 rows of outcomes
## num [1:1257, 1:200] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## num [1:1257, 1:240] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1257, 1:10] 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 ...
## [1] 300
## num [1:1257, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
## num [1:1257, 1:145] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
## num [1:1257, 1:360] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
## num [1:1257, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
## num [1:1257, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
## num [1:1257, 1:30] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 900
## num [1:1257, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
##
##
## Mean: 0.9787294 Variance: 852.6538
##
## Mean base return per hand: 0.9787112 with total variance: 852.2933
## Mean return per hand: 97.873% with total variance (sd as % of total bet): 13,244,178 ( 2.27% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0672 -0.0555 -0.0484 -0.0370 -0.0229 -0.0074 0.0080 0.0184 0.0390
##
## Mean base return per hand: 0.9787235 with total variance: 306.5758
## Mean return per hand: 97.792% with total variance (sd as % of total bet): 4,950,816 ( 2.78% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0811 -0.0666 -0.0569 -0.0407 -0.0237 -0.0046 0.0139 0.0236 0.0543
## num [1:1257, 1:11] 0 0 0 0 0 0 0 0 0 0 ...
## - attr(*, "dimnames")=List of 2
## ..$ : NULL
## ..$ : chr [1:11] "" "" "" "" ...
## [1] TRUE
## [1] TRUEproc.time() - startTime## user system elapsed
## 160.07 18.58 179.26# Define the paytable and simulate the holds (DDB 85)
startTime <- proc.time()
ddb85hnd2Score <- data.frame(idx=gameIndex, val=c( -1,
799, 49, 7, 4, 3,
2, 0, 0, 0, 0,
0, -1, -1, 399, 159,
159, 159, 159, 79, 79,
49, 49, 49, 49, 49
)
)
ddb85GameData <- genGame(hnd2Score=ddb85hnd2Score, useGameName="DDB 85")## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -1.0000 -1.0000 -0.7022 -1.0000 799.0000
##
## # A tibble: 11 × 2
## aScores ct
## <dbl> <int>
## 1 -1 2062860
## 2 0 461472
## 3 2 54912
## 4 3 10200
## 5 4 5108
## 6 7 3744
## 7 49 468
## 8 79 108
## 9 159 72
## 10 399 12
## 11 799 4
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1.0000 -0.9375 -0.8750 -0.7022 -0.7500 219.0000
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.9337 -0.8367 -0.8367 -0.7022 -0.6854 11.1600
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.8510 -0.8103 -0.7286 -0.7022 -0.6894 0.8204
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.7507 -0.7490 -0.7465 -0.7022 -0.6109 -0.5777
##
##
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6802 -0.5439 -0.2770 -0.0321 -0.0426 799.0000
##
## [1] 0.9678614
## [1] "Game DDB 85: Return: 0.96786 and Variance on Deal: 4.75"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -88.410 -40.500 -24.170 -15.980 -2.611 788.900
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -90.62 -46.80 -33.51 -34.12 -20.19 16.34
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -149.400 -69.270 -44.050 -29.000 -8.721 842.500
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -159.8000 -77.5300 -55.9600 -56.6500 -34.0700 0.6237
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -247.20 -121.50 -82.05 -65.62 -33.66 813.90
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -247.700 -133.300 -99.450 -99.180 -62.520 1.031
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -423.50 -214.70 -149.50 -124.10 -68.28 992.50
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -423.500 -230.900 -175.300 -173.200 -118.000 2.294
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -695.7 -384.2 -287.0 -260.3 -174.2 800.9
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -704.3000 -405.8000 -323.5000 -316.5000 -230.9000 -0.0236
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1159.0 -707.8 -557.0 -521.5 -381.9 1098.0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1171.000 -733.100 -603.000 -582.600 -443.100 -8.958
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1653.0 -1061.0 -855.9 -811.6 -609.8 1042.0
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -1659.00 -1088.00 -901.90 -880.50 -688.80 -6.66
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -2532 -1587 -1314 -1285 -1033 1257
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -2538.000 -1628.000 -1370.000 -1355.000 -1113.000 -6.046
## rndScore ct per
## 1 -1 951324 2.7
## 2 0 1359276 1.9
## 3 1 211968 12.3
## 4 2 948 2741.5
## 5 3 10236 253.9
## 6 4 42968 60.5
## 7 6 12672 205.1
## 8 7 3456 752.0
## 9 11 1992 1304.7
## 10 12 2520 1031.3
## 11 17 752 3456.1
## 12 18 52 49980.0
## 13 19 132 19689.1
## 14 49 468 5553.3
## 15 99 108 24064.4
## 16 159 36 72193.3
## 17 220 36 72193.3
## 18 399 12 216580.0
## 19 799 4 649740.0
## [1] 2598960 27
## [1] 270725 27
## [1] 22100 27
## [1] 1326 27
## [1] 52 27
## [1] 1 27
## idx 0 1 2 3 4 5 6 7 8 9 10 11
## [1,] 0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
## 12 13 14 15 16 17 18 19 20 21 22 23 24 25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1
##
## Summary of DDB 85 starting with row sums
##
## 1 47 1081 16215 178365 1533939
## 2150 19722 9477 72838 27838 2434
##
## 1
## 134459
##
## [1] "DDB 85: Overall EV and Mean"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.6802 -0.5439 -0.2770 -0.0321 -0.0426 799.0000
## [1] "Overall Return: 0.967861"
##
## [1] "DDB 85: Variances (Deal, Draw)"
## [1] "Deal Variance: 4.75"
## [1] "Draw Variance Summary Statistics"
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 5.006 8.255 37.240 19.940 13300.000
##
##
## This will assess the DDB 85 means and variances
##
## 1 -1 2 14 15
## 2 799 3
## 3 49 4 23 24 25 26 27
## 4 7 5
## 5 4 6
## 6 3 7
## 7 2 8
## 8 0 9 10 11 12 13
## 9 399 16
## 10 159 17 18 19 20
## 11 79 21 22
## [1] 1256
## num [1:1256, 1:11] 0 0 0 0 0 0 0 0 0 0 ...
## rSum ct
## 1 1 7
## 2 47 38
## 3 1081 112
## 4 16215 91
## 5 178365 512
## 6 1533939 496
## chr [1:134459] "0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-1-0-0" ...
## chr [1:1256] "0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-12-35-0" ...
## int [1:134459] 1 1 1 2 2 2 2 2 2 2 ...
## num [1:1256(1d)] 12 36 36 108 468 ...
## - attr(*, "dimnames")=List of 1
## ..$ : chr [1:1256] "1" "2" "3" "4" ...
## [1] 0.9678614
## [1] 37.24483
## scoreType occPer contRet occFreq
## 2 799 40070.000 0.019942 0.00002496
## 9 399 16240.000 0.024570 0.00006158
## 10 159 3158.000 0.050346 0.00031664
## 11 79 2601.000 0.030370 0.00038443
## 3 49 574.900 0.085225 0.00173928
## 4 7 92.020 0.076074 0.01086765
## 5 4 91.030 0.043941 0.01098528
## 6 3 77.210 0.038853 0.01295109
## 7 2 13.270 0.150669 0.07533427
## 8 0 2.983 0.000000 0.33520671
## 1 -1 1.811 -0.552128 0.55212811
##
## Printed table suggests DDB 85 mean return: 0.967862 and overall variance: 41.99557
##
## List of 1
## $ : int [1:11] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1256
## int [1:11, 1] 1 2 3 4 5 6 7 8 9 10 ...
## [,1]
## [1,] 1
## [2,] 2
## [3,] 3
## [4,] 4
## [5,] 5
## [6,] 6
##
##
## Number of unique outcome types: 11
##
## Moving to assess the: 11 rows of outcomes
##
##
## Mean: 0.9678614 Variance: 41.99487
## List of 3
## $ : int [1:1331] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1331] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:1331] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1256
## int [1:1331, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3]
## [1,] 1 1 1
## [2,] 1 1 2
## [3,] 1 1 3
## [4,] 1 1 4
## [5,] 1 1 5
## [6,] 1 1 6
##
##
## Number of unique outcome types: 199
##
## Moving to assess the: 199 rows of outcomes
## num [1:1256, 1:3, 1:3] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256, 1:3] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##
##
## Mean: 0.9678614 Variance: 154.4849
## List of 5
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1256
## int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 1017
##
## Moving to assess the: 1017 rows of outcomes
## num [1:1256, 1:150] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## num [1:1256, 1:270] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1256, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
## num [1:1256, 1:140] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
## num [1:1256, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
## num [1:1256, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
## num [1:1256, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
## num [1:1256, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
## num [1:1256, 1:30] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 900
## num [1:1256, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
##
##
## Mean: 0.9678614 Variance: 304.9752
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
## $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
##
## 1
## 1256
## int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 1 1
## [2,] 1 1 1 1 2
## [3,] 1 1 1 1 3
## [4,] 1 1 1 1 4
## [5,] 1 1 1 1 5
## [6,] 1 1 1 1 6
##
##
## Number of unique outcome types: 1017
##
## Moving to assess the: 1017 rows of outcomes
## num [1:1256, 1:150] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## num [1:1256, 1:270] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## num [1:1256, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
## num [1:1256, 1:140] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
## num [1:1256, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
## num [1:1256, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
## num [1:1256, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
## num [1:1256, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
## num [1:1256, 1:30] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 900
## num [1:1256, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
## num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
##
##
## Mean: 0.9678614 Variance: 847.4523
##
## Mean base return per hand: 0.967845 with total variance: 847.1118
## Mean return per hand: 96.786% with total variance (sd as % of total bet): 13,179,550 ( 2.27% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0778 -0.0664 -0.0591 -0.0478 -0.0337 -0.0182 -0.0027 0.0076 0.0281
##
## Mean base return per hand: 0.9678563 with total variance: 304.943
## Mean return per hand: 96.706% with total variance (sd as % of total bet): 4,923,107 ( 2.77% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0913 -0.0773 -0.0677 -0.0516 -0.0344 -0.0156 0.0027 0.0124 0.0437
## num [1:1256, 1:11] 0 0 0 0 0 0 0 0 0 0 ...
## - attr(*, "dimnames")=List of 2
## ..$ : NULL
## ..$ : chr [1:11] "" "" "" "" ...
## [1] TRUE
## [1] TRUEproc.time() - startTime## user system elapsed
## 156.88 18.07 175.44Next, the 10-play version of each is simulated for 12k deals (non-STP). Results are again cached for run-time performance:
jb85_10p_12k_fullmin_base <- sim_NPlay(keyFrame=jb85GameData$game_10Play$out10Play,
useName="JB 85", nPlay=10, nHands=12000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean base return per hand: 0.9729679 with total variance: 364.1599
## Mean return per hand: 97.338% with total variance (sd as % of total bet): 4,516,990 ( 1.77% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0597 -0.0505 -0.0459 -0.0380 -0.0288 -0.0180 -0.0063 0.0029 0.0372
jb75_10p_12k_fullmin_base <- sim_NPlay(keyFrame=jb75GameData$game_10Play$out10Play,
useName="JB 75", nPlay=10, nHands=12000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean base return per hand: 0.9614556 with total variance: 359.104
## Mean return per hand: 96.132% with total variance (sd as % of total bet): 4,234,183 ( 1.71% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0709 -0.0621 -0.0576 -0.0499 -0.0404 -0.0302 -0.0187 -0.0108 0.0261
bp65_10p_12k_fullmin_base <- sim_NPlay(keyFrame=bp65GameData$game_10Play$out10Play,
useName="BP 65", nPlay=10, nHands=12000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean base return per hand: 0.9686707 with total variance: 390.1796
## Mean return per hand: 96.814% with total variance (sd as % of total bet): 4,699,097 ( 1.81% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0662 -0.0576 -0.0522 -0.0434 -0.0332 -0.0227 -0.0112 -0.0029 0.0340
ddb95_10p_12k_fullmin_base <- sim_NPlay(keyFrame=ddb95GameData$game_10Play$out10Play,
useName="DDB 95", nPlay=10, nHands=12000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean base return per hand: 0.9787112 with total variance: 852.2933
## Mean return per hand: 97.812% with total variance (sd as % of total bet): 10,126,608 ( 2.65% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0742 -0.0621 -0.0539 -0.0401 -0.0242 -0.0055 0.0126 0.0251 0.0490
ddb85_10p_12k_fullmin_base <- sim_NPlay(keyFrame=ddb85GameData$game_10Play$out10Play,
useName="DDB 85", nPlay=10, nHands=12000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean base return per hand: 0.967845 with total variance: 847.1118
## Mean return per hand: 96.748% with total variance (sd as % of total bet): 10,090,584 ( 2.65% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0868 -0.0722 -0.0646 -0.0508 -0.0347 -0.0164 0.0014 0.0141 0.0434
The the RR (survival) curves are plotted:
graphRRSurvival(keyData=jb85_10p_12k_fullmin_base$fullminNPlay,
keyName="JB 85 10-play", keyBanks=seq(800, 4800, by=800)
)
graphRRSurvival(keyData=jb75_10p_12k_fullmin_base$fullminNPlay,
keyName="JB 75 10-play", keyBanks=seq(800, 4800, by=800)
)
graphRRSurvival(keyData=bp65_10p_12k_fullmin_base$fullminNPlay,
keyName="BP 65 10-play", keyBanks=seq(800, 4800, by=800)
)
graphRRSurvival(keyData=ddb95_10p_12k_fullmin_base$fullminNPlay,
keyName="DDB 95 10-play", keyBanks=seq(800, 4800, by=800)
)
graphRRSurvival(keyData=ddb85_10p_12k_fullmin_base$fullminNPlay,
keyName="DDB 85 10-play", keyBanks=seq(800, 4800, by=800)
)
Next, several variants of JB (JB 95 1-play, JB 95 5-play STP, JB 85 10-play) and DDB (DDB 95 1-play, DDB 95 5-play STP, DDB 85 10-play) are simulated for 12k deals (non-STP). Results are again cached for run-time performance:
jb95_01p_12k_fullmin_base <- sim_NPlay(keyFrame=jb95GameData$game_01Play$dfOutcome,
useName="JB 95", nPlay=1, nHands=12000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean base return per hand: 0.9844978 with total variance: 19.49537
## Mean return per hand: 98.464% with total variance (sd as % of total bet): 238,724 ( 4.07% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0717 -0.0611 -0.0544 -0.0432 -0.0284 0.0073 0.0412 0.0619 0.1107
jb95_05p_12k_fullmin_stp <- sim_NPlay(keyFrame=jb95GameData$game_05Play$dfOutcome,
useName="JB 95", nPlay=5, nHands=12000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE, runSTP=TRUE
)##
## Mean base return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.801% with total variance (sd as % of total bet): 4,038,004 ( 2.79% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0600 -0.0473 -0.0414 -0.0300 -0.0158 0.0004 0.0196 0.0356 0.0824
jb85_10p_12k_fullmin_base <- sim_NPlay(keyFrame=jb85GameData$game_10Play$out10Play,
useName="JB 85", nPlay=10, nHands=12000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean base return per hand: 0.9729679 with total variance: 364.1599
## Mean return per hand: 97.275% with total variance (sd as % of total bet): 4,284,743 ( 1.72% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0588 -0.0514 -0.0471 -0.0386 -0.0290 -0.0181 -0.0069 0.0015 0.0337
ddb95_01p_12k_fullmin_base <- sim_NPlay(keyFrame=ddb95GameData$game_01Play$dfOutcome,
useName="DDB 95", nPlay=1, nHands=12000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean base return per hand: 0.9787302 with total variance: 42.16757
## Mean return per hand: 97.852% with total variance (sd as % of total bet): 495,179 ( 5.86% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.1315 -0.1065 -0.0910 -0.0627 -0.0281 0.0139 0.0572 0.0828 0.1398
ddb95_05p_12k_fullmin_stp <- sim_NPlay(keyFrame=ddb95GameData$game_05Play$dfOutcome,
useName="DDB 95", nPlay=5, nHands=12000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE, runSTP=TRUE
)##
## Mean base return per hand: 0.9787235 with total variance: 306.5758
## Mean return per hand: 98.132% with total variance (sd as % of total bet): 8,700,098 ( 4.1% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0933 -0.0757 -0.0649 -0.0466 -0.0236 0.0039 0.0332 0.0551 0.1040
ddb85_10p_12k_fullmin_base <- sim_NPlay(keyFrame=ddb85GameData$game_10Play$out10Play,
useName="DDB 85", nPlay=10, nHands=12000, nSims=4000,
genCumMin=TRUE, genFullMin=TRUE
)##
## Mean base return per hand: 0.967845 with total variance: 847.1118
## Mean return per hand: 96.762% with total variance (sd as % of total bet): 9,981,042 ( 2.63% )
## 1% 5% 10% 25% 50% 75% 90% 95% 99%
## -0.0850 -0.0713 -0.0639 -0.0507 -0.0346 -0.0163 0.0018 0.0134 0.0429
Then, the RR (survival) curves are plotted for JB, with 1-play (1 and 2) plotted twice for legends:
# 25k at 5k (0.6k-0.8k units for 100%, 0.4k units for 95%, 0.2k units for 50%)
# 50k at 10k (1.0k-1.2k units for 100%, 0.6k-0.8k units for 95%, 0.4k units for 50%)
graphRRSurvival(keyData=jb95_01p_12k_fullmin_base$fullminNPlay,
keyName="JB 95 1-play (base 1; 60k total)",
keyBanks=seq(200, 1200, by=200)
)
# 25k at 3.3k (2.4k for 100%, 1.6k for 95%, <0.8k for 50%)
# 50k at 6.7k (4.0k for 100%, 2.4k for 95%, 0.8k - 1.6k for 50%)
graphRRSurvival(keyData=jb95_05p_12k_fullmin_stp$fullminNPlay,
keyName="JB 95 5-play STP (base 0.25; 90k total)",
keyBanks=seq(800, 4800, by=800)
)
# 25k at 2.5k (0.5k units for 100%, 0.2k-0.3k units for 95%, 0.1k-0.2k units for 50%)
# 50k at 5k (>0.6k units for 100%, 0.4k units for 95%, 0.2k units for 50%)
graphRRSurvival(keyData=jb95_01p_12k_fullmin_base$fullminNPlay,
keyName="JB 95 1-play (base 2; 120k total)",
keyBanks=seq(100, 600, by=100)
)
# 25k at 2k (2.4k units for 100%, 1.6k units for 95%, 0.8k units for 50%)
# 50k at 4k (4.0k units for 100%, 2.4k-3.2k units for 95%, 1.6k units for 50%)
graphRRSurvival(keyData=jb85_10p_12k_fullmin_base$fullminNPlay,
keyName="JB 85 10-play (base 0.25; 150k total)",
keyBanks=seq(800, 4800, by=800)
)
And, RR (survival) curves are plotted for DDB, with 1-play (1 and 2) plotted twice for legends:
# 25k at 5k (1.2k units for 100%, 0.8k units for 95%, 0.2k-0.4k units for 50%)
# 50k at 10k (>1.2k units for 100%, 1.2k units for 95%, 0.6k units for 50%)
graphRRSurvival(keyData=ddb95_01p_12k_fullmin_base$fullminNPlay,
keyName="DDB 95 1-play (base 1; 60k total)",
keyBanks=seq(200, 1200, by=200)
)
# 25k at 3.3k (4.0k for 100%, 2.4k for 95%, 0.8k-1.6k for 50%)
# 50k at 6.7k (>4.8k for 100%, 4.0k for 95%, 1.6k for 50%)
graphRRSurvival(keyData=ddb95_05p_12k_fullmin_stp$fullminNPlay,
keyName="DDB 95 5-play STP (base 0.25; 90k total)",
keyBanks=seq(800, 4800, by=800)
)
# 25k at 2.5k (>0.6k units for 100%, 0.5k units for 95%, 0.2k-0.3k units for 50%)
# 50k at 5k (>0.6k units for 100%, >0.6k units for 95%, 0.3k-0.4k units for 50%)
graphRRSurvival(keyData=ddb95_01p_12k_fullmin_base$fullminNPlay,
keyName="DDB 95 1-play (base 2; 120k total)",
keyBanks=seq(100, 600, by=100)
)
# 25k at 2k (4.0k units for 100%, 2.4k units for 95%, 0.8k-1.6k units for 50%)
# 50k at 4k (>4.8k units for 100%, 4.0k units for 95%, 1.6k-2.4k units for 50%)
graphRRSurvival(keyData=ddb85_10p_12k_fullmin_base$fullminNPlay,
keyName="DDB 85 10-play (base 0.25; 150k total)",
keyBanks=seq(800, 4800, by=800)
)
A variant of the graphRRSurvival() function is created that can plot multiple games, out to different # hands, and assess a particular risk of ruin for them:
library(stringr)
graphRRMultiGame <- function(keyList, keyLabel, keyBanks, keyDenom, grName,
keyPct=c(1, 0.95, 0.8, 0.5),
keyCol=c("red", "orange", "purple", "blue", "grey", "green")
) {
# Check that data lengths are OK
if ((length(keyList) != length(keyLabel)) |
(length(keyList) != length(keyBanks)) |
(length(keyList) != length(keyDenom)) |
(length(keyList) > length(keyCol))
) {
cat("\nkeyList: ", length(keyList), " keyLabel: ", length(keyLabel),
" keyBanks: ", length(keyBanks), " keyCol: ", length(keyCol),
" keyDenom: ", length(keyDenom), "\n"
)
stop("Function will abort due to length mismatches:")
}
# Survival Curves for each element of keyList
mtxData <- matrix(data=NA, nrow=length(keyList), ncol=length(keyPct))
for (listNum in 1:length(keyList)) {
keyData <- keyList[[listNum]]
nBank <- keyBanks[listNum]
mtxSurv <- rowMeans(keyData > -nBank)
if (listNum == 1) {
plot(x=as.numeric(names(mtxSurv))/keyDenom[listNum], y=unname(mtxSurv),
main=grName,
xlab="% to Target", ylab="Survival",
pch=19, col=keyCol[listNum], cex=0.5,
ylim=c(0, 1), xlim=c(0, 1)
)
} else {
points(x=as.numeric(names(mtxSurv))/keyDenom[listNum], y=unname(mtxSurv),
pch=19, col=keyCol[listNum], cex=0.5
)
}
for (intCtr in seq_along(keyPct)) {
mtxData[listNum, intCtr] <-
as.numeric(names(mtxSurv)[sum(mtxSurv >= keyPct[intCtr])]) / keyDenom[listNum]
}
}
abline(h=keyPct, lty=2)
topRow <- paste(str_pad("% Achd", width=7+max(nchar(keyLabel)), side="both"), "( ",
paste(paste0(round(100*keyPct, 1), "%"), collapse=" | "),
" )"
)
appData <- apply(pmin(mtxData, 1), 1,
FUN=function(x) {
paste(format(round(x*100, 1), nsmall=1, width=5), collapse="% | ")
}
)
legend("bottomleft",
legend=c(topRow,
paste0(str_pad(keyLabel, width=max(nchar(keyLabel)), side="right"),
" ( ", appData, "% )"
)
),
col=c("white", keyCol), cex=0.8, pch=19, pt.cex=1.2
)
}The algorithm is then attempted for a few primary methods of hitting the same coin-in:
- JB 95 5-play (12,000 deals target with 2,400 units bank)
- JB 95 5-play STP (10,000 deals target with 2,400 units bank)
- JB 95 1-play (15,000 deals target with 600 units bank)
- JB 85 10-play (6,000 deals target with 2,400 units bank)
- JB 95 1-play (7,500 deals target with 300 units bank)
gmList <- list(jb95_05_bas_v1=jb95_05p_24k_fullmin$fullminNPlay,
jb95_05_stp_v1=jb95_05p_12k_fullmin_stp$fullminNPlay,
jb95_01_v1=jb95_01p_24k_fullmin$fullminNPlay,
jb85_10_v1=jb85_10p_12k_fullmin_base$fullminNPlay,
jb95_01_v2=jb95_01p_12k_fullmin_base$fullminNPlay
)
gmLabel=c("JB 95 5-p", "JB 95 5-p STP", "JB 95 1-p (sm)", "JB 85 10-p", "JB 95 1-p (lg)")
gmDenom=c(12000, 10000, 15000, 6000, 7500)
# Run it for the 3k bank
gmBanks=c(2400, 2400, 600, 2400, 300)
graphRRMultiGame(keyList=gmList, keyLabel=gmLabel, keyBanks=gmBanks,
keyDenom=gmDenom, grName="Survival Curves (Target=7.5k TC using 3k bank)",
keyPct=c(1, 0.99, 0.95, 0.8, 0.5)
)
# Run it for the 4k bank
gmBanks=c(3200, 3200, 800, 3200, 400)
graphRRMultiGame(keyList=gmList, keyLabel=gmLabel, keyBanks=gmBanks,
keyDenom=gmDenom, grName="Survival Curves (Target=7.5k TC using 4k bank)",
keyPct=c(1, 0.99, 0.95, 0.8, 0.5)
)
# Run it for the 5k bank
gmBanks=c(4000, 4000, 1000, 4000, 500)
graphRRMultiGame(keyList=gmList, keyLabel=gmLabel, keyBanks=gmBanks,
keyDenom=gmDenom, grName="Survival Curves (Target=7.5k TC using 5k bank)",
keyPct=c(1, 0.99, 0.95, 0.8, 0.5)
)
# Run it for the 2k bank
gmBanks=c(1600, 1600, 400, 1600, 200)
graphRRMultiGame(keyList=gmList, keyLabel=gmLabel, keyBanks=gmBanks,
keyDenom=gmDenom, grName="Survival Curves (Target=7.5k TC using 2k bank)",
keyPct=c(1, 0.99, 0.95, 0.8, 0.5)
)